--- 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'!