--- a/RegressionTests__VMCrashTestCase.st Fri Sep 05 21:04:10 2014 +0200
+++ b/RegressionTests__VMCrashTestCase.st Mon Sep 08 14:45:55 2014 +0200
@@ -18,6 +18,14 @@
if it eventually crashes the VM, it won't take whole test
suite with it.
+ Each test case *must* be annotated by one <spawn:> annotation,
+ argument must be either `true` of `false`. If `true` then the
+ test is run in a freshly started VM. If `false`, test is run
+ in the same VM.
+
+ As this is meant as a base class for regression tests that used to
+ kill the VM, normally you should annotate tests with <spawn: true>
+
[author:]
Jan Vrany <jan.vrany@fit.cvut.cz>
@@ -50,16 +58,46 @@
^ self == RegressionTests::VMCrashTestCase
! !
+!VMCrashTestCase methodsFor:'accessing'!
+
+timeout
+ "Returns a default timeout (sec) for the test.
+ If nil is returned, no timeout enforced.
+
+ Note that the timeout is set only when running under
+ report runner, interactive tools does not use it"
+
+ | method |
+ method := self class lookupMethodFor: testSelector.
+ method annotationsAt:#timeout: do:[:annotation|
+ ^annotation arguments first
+ ].
+ ^60"sec - default timeout"
+
+ "Created: / 08-09-2014 / 13:00:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!VMCrashTestCase methodsFor:'running'!
runCase
- "Actually peform the testcase in a separate process"
+ "Perform the testcase.
- | testcaseFile exe args script environment outputFile output pid blocker status |
+ If testcase is annotated by <spawn: false> the test is run in the
+ very same VM. If <spawn: true>, a new VM is started and the testcase
+ in run in that new VM"
+
+ | testcaseFile exe args script environment outputFile output pid blocker status spawn |
- "/ A hack to run infrastructure test...
- (testSelector == #test_infrastructure) ifTrue:[
+ spawn := (self class lookupMethodFor: testSelector) annotationAt: #spawn:.
+ spawn isNil ifTrue:[
+ self error: 'No <spawn:> annotation'.
+ ].
+ (spawn argumentAt: 1) == false ifTrue:[
^ super runCase.
+ ] ifFalse:[
+ (spawn argumentAt: 1) ~~ true ifTrue:[
+ self error: 'Argument to <spawn:> must be either `true` or `false`'.
+ ]
].
[
@@ -145,8 +183,12 @@
outputFile
].
+ "
+ VMCrashTestCase run:#test_infrastructure
+ "
+
"Created: / 04-09-2014 / 18:13:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 05-09-2014 / 19:03:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-09-2014 / 12:31:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runCaseInternal
@@ -174,6 +216,7 @@
"
VMCrashTestCase run:#test_infrastructure
"
+ <spawn: false>
| result |
@@ -201,32 +244,43 @@
self assert: result errorCount = 1.
"Created: / 05-09-2014 / 18:22:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-09-2014 / 12:26:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
tst_crash
+
+ <spawn: true>
+
| bytes |
bytes := ExternalBytes address: 16r10 size: 100.
bytes byteAt: 1 put: 10.
"Created: / 05-09-2014 / 18:24:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-09-2014 / 12:26:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
tst_error
+ <spawn: true>
self error:'Error'
"Created: / 05-09-2014 / 18:20:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-09-2014 / 12:26:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
tst_fail
+ <spawn: true>
self assert: false.
"Created: / 05-09-2014 / 18:20:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-09-2014 / 12:26:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-tst_pass
+tst_pass
+ <spawn: true>
"Created: / 05-09-2014 / 18:20:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-09-2014 / 12:26:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VMCrashTestCase class methodsFor:'documentation'!