More support for debugging - file out also some scripts useful when debugging the test.
--- 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