More support for debugging - file out also some scripts useful when debugging the test.
authorJan Vrany <jan.vrany@fit.cvut.cz>
Tue, 16 Sep 2014 22:47:20 +0200
changeset 1194 01167ea2ad14
parent 1193 4fd89b765c87
child 1195 a0079913b716
More support for debugging - file out also some scripts useful when debugging the test.
RegressionTests__VMCrashTestCase.st
--- a/RegressionTests__VMCrashTestCase.st	Tue Sep 16 19:50:50 2014 +0200
+++ b/RegressionTests__VMCrashTestCase.st	Tue Sep 16 22:47:20 2014 +0200
@@ -86,7 +86,7 @@
      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 |
+    | tempDir testcaseFile exe args script environment outputFile output pid blocker status spawn |
 
     spawn := (self class lookupMethodFor: testSelector) annotationAt: #spawn:.
     spawn isNil ifTrue:[ 
@@ -101,7 +101,9 @@
     ].
 
     [
-        testcaseFile := Filename newTemporary.
+        tempDir := Filename newTemporary.
+        tempDir makeDirectory.
+        testcaseFile := tempDir / ((Smalltalk fileNameForClass: self class) , '.st').
         self class fileOutAs: testcaseFile.
 
         script := 'Smalltalk packagePath: %1. 
@@ -125,9 +127,22 @@
             ]   
         ].
 
-        outputFile := Filename newTemporary.
+        outputFile := tempDir / 'output.txt'.
         output := outputFile writeStream.
 
+        "/ Now, spit out some helper files that for debugging.
+        ( tempDir / 'run.st' ) writingFileDo:[ :f |
+            f nextPutAll: script.
+        ].
+        ( tempDir / 'run.sh' ) writingFileDo:[ :f |
+            f nextPutAll: exe.
+            f space.
+            f nextPutAll: '--abortOnSEGV'.
+            f space.
+            f nextPutAll: '--execute'.
+            f space.
+            f nextPutAll: 'run.st'.
+        ].
         environment := OperatingSystem isUNIXlike
                         ifTrue:[OperatingSystem getEnvironment copy]
                         ifFalse:[environment := Dictionary new].  
@@ -136,7 +151,7 @@
         Processor monitor:[ 
              pid := OperatingSystem exec: exe withArguments:args
                 environment:environment
-                fileDescriptors:{0 . output fileDescriptor . output fileDescriptor }
+                fileDescriptors:"{0 . output fileDescriptor  . output fileDescriptor  }"#(0 1 2)
                 fork:true
                 newPgrp:false
                 inDirectory: Filename currentDirectory pathName            
@@ -177,10 +192,9 @@
             self error: 'Error occured'.
         ].
     ] ensure:[ 
-        (testcaseFile notNil and:[testcaseFile exists]) ifTrue:[ 
-            testcaseFile remove.
+        (tempDir notNil and:[tempDir exists]) ifTrue:[ 
+            tempDir remove.
         ].
-        outputFile
     ].
 
     "
@@ -188,7 +202,7 @@
     "
 
     "Created: / 04-09-2014 / 18:13:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 08-09-2014 / 12:31:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 16-09-2014 / 21:06:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 runCaseInternal
@@ -253,11 +267,13 @@
     
     | bytes | 
 
+    Stdout nextPutLine: 'Going to crash now!!'.
+
     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>"
+    "Modified: / 16-09-2014 / 20:30:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 tst_error