--- a/RegressionTests__VMCrashTestCase.st Wed Jun 29 21:40:53 2016 +0100
+++ b/RegressionTests__VMCrashTestCase.st Thu Jun 30 09:02:08 2016 +0100
@@ -29,7 +29,7 @@
kill the VM, normally you should annotate tests with <spawn: true>
[author:]
- Jan Vrany <jan.vrany@fit.cvut.cz>
+ Jan Vrany <jan.vrany@fit.cvut.cz>
[instance variables:]
@@ -72,7 +72,7 @@
| method |
method := self class lookupMethodFor: testSelector.
method annotationsAt:#timeout: do:[:annotation|
- ^annotation arguments first
+ ^annotation arguments first
].
^60"sec - default timeout"
@@ -91,109 +91,109 @@
| tempDir testcaseFile exe args script environment outputFile output pid blocker status spawn |
spawn := (self class lookupMethodFor: testSelector) annotationAt: #spawn:.
- spawn isNil ifTrue:[
- self error: 'No <spawn:> annotation'.
+ 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`'.
- ]
+ (spawn argumentAt: 1) == false ifTrue:[
+ ^ super runCase.
+ ] ifFalse:[
+ (spawn argumentAt: 1) ~~ true ifTrue:[
+ self error: 'Argument to <spawn:> must be either `true` or `false`'.
+ ]
].
[
- tempDir := Filename newTemporary.
- tempDir makeDirectory.
- testcaseFile := tempDir / ((Smalltalk fileNameForClass: self class) , '.st').
- self class fileOutAs: testcaseFile.
+ tempDir := Filename newTemporary.
+ tempDir makeDirectory.
+ testcaseFile := tempDir / ((Smalltalk fileNameForClass: self class) , '.st').
+ self class fileOutAs: testcaseFile.
- script := 'Smalltalk packagePath: %1.
- Smalltalk loadPackage:%2.
- Smalltalk fileIn: %3.
- (%4 selector: %5) runCaseInternal.'
- bindWith: Smalltalk packagePath asArray storeString
- with: self class package storeString
- with: testcaseFile pathName storeString
- with: self class name
- with: testSelector storeString.
+ script := 'Smalltalk packagePath: %1.
+ Smalltalk loadPackage:%2.
+ Smalltalk fileIn: %3.
+ (%4 selector: %5) runCaseInternal.'
+ bindWith: Smalltalk packagePath asArray storeString
+ with: self class package storeString
+ with: testcaseFile pathName storeString
+ with: self class name
+ with: testSelector storeString.
- exe := OperatingSystem pathOfSTXExecutable.
- args := { exe . '--abortOnSEGV' . '--execute' . ( tempDir / 'run.st' ) pathName }.
+ exe := OperatingSystem pathOfSTXExecutable.
+ args := { exe . '--abortOnSEGV' . '--execute' . ( tempDir / 'run.st' ) pathName }.
- OperatingSystem isMSWINDOWSlike ifTrue:[
- args := String streamContents:[:s|
- args
- do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]
- separatedBy: [ s space ]
- ]
- ].
+ OperatingSystem isMSWINDOWSlike ifTrue:[
+ args := String streamContents:[:s|
+ args
+ do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]
+ separatedBy: [ s space ]
+ ]
+ ].
- outputFile := tempDir / 'output.txt'.
- output := outputFile writeStream.
+ outputFile := tempDir / 'output.txt'.
+ output := outputFile writeStream.
- "/ Now, spit out some helper files that for debugging.
- ( tempDir / 'run.st' ) writingFileDo:[ :f |
- f nextPutAll: script.
- ].
- environment := OperatingSystem isUNIXlike
- ifTrue:[OperatingSystem getEnvironment copy]
- ifFalse:[environment := Dictionary new].
- blocker := Semaphore new.
+ "/ Now, spit out some helper files that for debugging.
+ ( tempDir / 'run.st' ) writingFileDo:[ :f |
+ f nextPutAll: script.
+ ].
+ environment := OperatingSystem isUNIXlike
+ ifTrue:[OperatingSystem getEnvironment copy]
+ ifFalse:[environment := Dictionary new].
+ blocker := Semaphore new.
- Processor monitor:[
- pid := OperatingSystem exec: exe withArguments:args
- environment:environment
- fileDescriptors:{0 . output fileDescriptor . output fileDescriptor }
- fork:true
- newPgrp:false
- inDirectory: Filename currentDirectory pathName
- ] action: [ :s |
- status := s.
- blocker signal.
- ].
+ Processor monitor:[
+ pid := OperatingSystem exec: exe withArguments:args
+ environment:environment
+ fileDescriptors:{0 . output fileDescriptor . output fileDescriptor }
+ fork:true
+ newPgrp:false
+ inDirectory: Filename currentDirectory pathName
+ ] action: [ :s |
+ status := s.
+ blocker signal.
+ ].
- output close.
+ output close.
- pid isNil ifTrue:[
- self error: 'Failed to spawn test'.
- ^ self.
- ].
+ pid isNil ifTrue:[
+ self error: 'Failed to spawn test'.
+ ^ self.
+ ].
- blocker wait.
+ blocker wait.
- status code == EXIT_CODE_FAILURE ifTrue:[
- (outputFile notNil and:[ outputFile exists ]) ifTrue:[
- Stdout nextPutAll: '== TEST FAILED: '; nextPutAll: testSelector; nextPutLine:' =='.
- outputFile readingFileDo:[:s|
- [ s atEnd ] whileFalse:[
- Stdout nextPutLine: s nextLine.
- ].
- ].
- ].
- self assert: false description: 'Assertion failed, see log'.
- ].
- (status code == EXIT_CODE_ERROR or:[status status == #signal]) ifTrue:[
- (outputFile notNil and:[ outputFile exists ]) ifTrue:[
- Stdout nextPutAll: '== TEST ERROR: '; nextPutAll: testSelector; nextPutLine:' =='.
- outputFile readingFileDo:[:s|
- [ s atEnd ] whileFalse:[
- Stdout nextPutLine: s nextLine.
- ].
- ].
- ].
- self error: 'Error occured'.
- ].
- ] ensure:[
- (tempDir notNil and:[tempDir exists]) ifTrue:[
- [
- tempDir recursiveRemove.
- ] on: Error do:[:ex |
- OperatingSystem isMSWINDOWSlike ifFalse:[
- ex reject.
- ].
- ]
- ].
+ status code == EXIT_CODE_FAILURE ifTrue:[
+ (outputFile notNil and:[ outputFile exists ]) ifTrue:[
+ Stdout nextPutAll: '== TEST FAILED: '; nextPutAll: testSelector; nextPutLine:' =='.
+ outputFile readingFileDo:[:s|
+ [ s atEnd ] whileFalse:[
+ Stdout nextPutLine: s nextLine.
+ ].
+ ].
+ ].
+ self assert: false description: 'Assertion failed, see log'.
+ ].
+ (status code == EXIT_CODE_ERROR or:[status status == #signal]) ifTrue:[
+ (outputFile notNil and:[ outputFile exists ]) ifTrue:[
+ Stdout nextPutAll: '== TEST ERROR: '; nextPutAll: testSelector; nextPutLine:' =='.
+ outputFile readingFileDo:[:s|
+ [ s atEnd ] whileFalse:[
+ Stdout nextPutLine: s nextLine.
+ ].
+ ].
+ ].
+ self error: 'Error occured'.
+ ].
+ ] ensure:[
+ (tempDir notNil and:[tempDir exists]) ifTrue:[
+ [
+ tempDir recursiveRemove.
+ ] on: Error do:[:ex |
+ OperatingSystem isMSWINDOWSlike ifFalse:[
+ ex reject.
+ ].
+ ]
+ ].
].
"
@@ -206,17 +206,17 @@
runCaseInternal
[
- super runCase.
- Stdout cr;
- nextPutAll: 'PASSED'; cr.
+ super runCase.
+ Stdout cr;
+ nextPutAll: 'PASSED'; cr.
] on: TestResult failure do:[:failure |
- Stdout cr;
- nextPutAll: 'FAILURE: '; nextPutAll: failure description; cr.
- Smalltalk exit: EXIT_CODE_FAILURE.
+ Stdout cr;
+ nextPutAll: 'FAILURE: '; nextPutAll: failure description; cr.
+ Smalltalk exit: EXIT_CODE_FAILURE.
] on: TestResult exError do:[:error |
- Stdout cr;
- nextPutAll: 'ERROR: '; nextPutAll: error description; cr.
- Smalltalk exit: EXIT_CODE_ERROR.
+ Stdout cr;
+ nextPutAll: 'ERROR: '; nextPutAll: error description; cr.
+ Smalltalk exit: EXIT_CODE_ERROR.
].
"Created: / 04-09-2014 / 17:41:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -249,7 +249,7 @@
self assert: result errorCount = 1.
"
- VMCrashTestCase run: #tst_crash.
+ VMCrashTestCase run: #tst_crash.
"
result := self class run: #tst_crash.
self assert: result passedCount = 0.
@@ -263,8 +263,8 @@
tst_crash
<spawn: true>
-
- | bytes |
+
+ | bytes |
Stdout nextPutLine: 'Going to crash now!!'.
@@ -291,7 +291,7 @@
"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>"