Mercurial Mercurial > hg > stx-goodies-regression / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
RegressionTests__VMCrashTestCase.st
branchjv
changeset 1500 d406a10b2965
parent 1499 26a16a04219b
parent 1447 2351db93aa5b
child 1502 b52f4f0d4a0b
equal deleted inserted replaced
1499:26a16a04219b 1500:d406a10b2965 
    27 
    27 
    28     As this is meant as a base class for regression tests that used to
 
    28     As this is meant as a base class for regression tests that used to
 
    29     kill the VM, normally you should annotate tests with <spawn: true>
 
    29     kill the VM, normally you should annotate tests with <spawn: true>
 
    30 
    30 
    31     [author:]
 
    31     [author:]
 
    32         Jan Vrany <jan.vrany@fit.cvut.cz>
 
    32 	Jan Vrany <jan.vrany@fit.cvut.cz>
 
    33 
    33 
    34     [instance variables:]
 
    34     [instance variables:]
 
    35 
    35 
    36     [class variables:]
 
    36     [class variables:]
 
    37 
    37 
    70     report runner, interactive tools does not use it"
 
    70     report runner, interactive tools does not use it"
 
    71 
    71 
    72     | method |
 
    72     | method |
 
    73     method := self class lookupMethodFor: testSelector.
 
    73     method := self class lookupMethodFor: testSelector.
 
    74     method annotationsAt:#timeout: do:[:annotation|
 
    74     method annotationsAt:#timeout: do:[:annotation|
 
    75          ^annotation arguments first
 
    75 	 ^annotation arguments first
 
    76     ].
 
    76     ].
 
    77     ^60"sec - default timeout"
 
    77     ^60"sec - default timeout"
 
    78 
    78 
    79     "Created: / 08-09-2014 / 13:00:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
    79     "Created: / 08-09-2014 / 13:00:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
    80 ! !
 
    80 ! !
 
    89      in run in that new VM"
 
    89      in run in that new VM"
 
    90 
    90 
    91     | tempDir testcaseFile exe args script environment outputFile output pid blocker status spawn |
 
    91     | tempDir testcaseFile exe args script environment outputFile output pid blocker status spawn |
 
    92 
    92 
    93     spawn := (self class lookupMethodFor: testSelector) annotationAt: #spawn:.
 
    93     spawn := (self class lookupMethodFor: testSelector) annotationAt: #spawn:.
 
    94     spawn isNil ifTrue:[ 
    94     spawn isNil ifTrue:[
 
    95         self error: 'No <spawn:> annotation'.
 
    95 	self error: 'No <spawn:> annotation'.
 
    96     ].
 
    96     ].
 
    97     (spawn argumentAt: 1) == false ifTrue:[ 
    97     (spawn argumentAt: 1) == false ifTrue:[
 
    98         ^ super runCase.
 
    98 	^ super runCase.
 
    99     ] ifFalse:[ 
    99     ] ifFalse:[
 
   100         (spawn argumentAt: 1) ~~ true ifTrue:[ 
   100 	(spawn argumentAt: 1) ~~ true ifTrue:[
 
   101             self error: 'Argument to <spawn:> must be either `true` or `false`'.
 
   101 	    self error: 'Argument to <spawn:> must be either `true` or `false`'.
 
   102         ]
 
   102 	]
 
   103     ].
 
   103     ].
 
   104 
   104 
   105     [
 
   105     [
 
   106         tempDir := Filename newTemporary.
 
   106 	tempDir := Filename newTemporary.
 
   107         tempDir makeDirectory.
 
   107 	tempDir makeDirectory.
 
   108         testcaseFile := tempDir / ((Smalltalk fileNameForClass: self class) , '.st').
 
   108 	testcaseFile := tempDir / ((Smalltalk fileNameForClass: self class) , '.st').
 
   109         self class fileOutAs: testcaseFile.
 
   109 	self class fileOutAs: testcaseFile.
 
   110 
   110 
   111         script := 'Smalltalk packagePath: %1. 
   111 	script := 'Smalltalk packagePath: %1.
 
   112                    Smalltalk loadPackage:%2. 
   112 		   Smalltalk loadPackage:%2.
 
   113                    Smalltalk fileIn: %3.
 
   113 		   Smalltalk fileIn: %3.
 
   114                    (%4 selector: %5) runCaseInternal.'
 
   114 		   (%4 selector: %5) runCaseInternal.'
 
   115                     bindWith: Smalltalk packagePath asArray storeString
 
   115 		    bindWith: Smalltalk packagePath asArray storeString
 
   116                         with: self class package storeString
 
   116 			with: self class package storeString
 
   117                         with: testcaseFile pathName storeString
 
   117 			with: testcaseFile pathName storeString
 
   118                         with: self class name
 
   118 			with: self class name
 
   119                         with: testSelector storeString.
 
   119 			with: testSelector storeString.
 
   120 
   120 
   121         exe := OperatingSystem pathOfSTXExecutable.
 
   121 	exe := OperatingSystem pathOfSTXExecutable.
 
   122         args := { exe . '--abortOnSEGV' . '--execute' . ( tempDir / 'run.st' ) pathName }.
 
   122 	args := { exe . '--abortOnSEGV' . '--execute' . ( tempDir / 'run.st' ) pathName }.
 
   123 
   123 
   124         OperatingSystem isMSWINDOWSlike ifTrue:[ 
   124 	OperatingSystem isMSWINDOWSlike ifTrue:[
 
   125             args := String streamContents:[:s|
 
   125 	    args := String streamContents:[:s|
 
   126                 args
 
   126 		args
 
   127                     do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]
 
   127 		    do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]
 
   128                     separatedBy: [ s space ]
 
   128 		    separatedBy: [ s space ]
 
   129             ]   
   129 	    ]
 
   130         ].
 
   130 	].
 
   131 
   131 
   132         outputFile := tempDir / 'output.txt'.
 
   132 	outputFile := tempDir / 'output.txt'.
 
   133         output := outputFile writeStream.
 
   133 	output := outputFile writeStream.
 
   134 
   134 
   135         "/ Now, spit out some helper files that for debugging.
 
   135 	"/ Now, spit out some helper files that for debugging.
 
   136         ( tempDir / 'run.st' ) writingFileDo:[ :f |
 
   136 	( tempDir / 'run.st' ) writingFileDo:[ :f |
 
   137             f nextPutAll: script.
 
   137 	    f nextPutAll: script.
 
   138         ].
 
   138 	].
 
   139         environment := OperatingSystem isUNIXlike
 
   139 	environment := OperatingSystem isUNIXlike
 
   140                         ifTrue:[OperatingSystem getEnvironment copy]
 
   140 			ifTrue:[OperatingSystem getEnvironment copy]
 
   141                         ifFalse:[environment := Dictionary new].  
   141 			ifFalse:[environment := Dictionary new].
 
   142         blocker := Semaphore new.
 
   142 	blocker := Semaphore new.
 
   143 
   143 
   144         Processor monitor:[ 
   144 	Processor monitor:[
 
   145              pid := OperatingSystem exec: exe withArguments:args
 
   145 	     pid := OperatingSystem exec: exe withArguments:args
 
   146                 environment:environment
 
   146 		environment:environment
 
   147                 fileDescriptors:{0 . output fileDescriptor  . output fileDescriptor  }
 
   147 		fileDescriptors:{0 . output fileDescriptor  . output fileDescriptor  }
 
   148                 fork:true
 
   148 		fork:true
 
   149                 newPgrp:false
 
   149 		newPgrp:false
 
   150                 inDirectory: Filename currentDirectory pathName            
   150 		inDirectory: Filename currentDirectory pathName
 
   151         ] action: [ :s |
 
   151 	] action: [ :s |
 
   152             status := s.
 
   152 	    status := s.
 
   153             blocker signal.        
   153 	    blocker signal.
 
   154         ].
 
   154 	].
 
   155 
   155 
   156         output close.
 
   156 	output close.
 
   157 
   157 
   158         pid isNil ifTrue:[ 
   158 	pid isNil ifTrue:[
 
   159             self error: 'Failed to spawn test'.
 
   159 	    self error: 'Failed to spawn test'.
 
   160             ^ self.
 
   160 	    ^ self.
 
   161         ].
 
   161 	].
 
   162 
   162 
   163         blocker wait.
 
   163 	blocker wait.
 
   164 
   164 
   165         status code == EXIT_CODE_FAILURE ifTrue:[ 
   165 	status code == EXIT_CODE_FAILURE ifTrue:[
 
   166             (outputFile notNil and:[ outputFile exists ]) ifTrue:[ 
   166 	    (outputFile notNil and:[ outputFile exists ]) ifTrue:[
 
   167                 Stdout nextPutAll: '== TEST FAILED: '; nextPutAll: testSelector; nextPutLine:' =='.
 
   167 		Stdout nextPutAll: '== TEST FAILED: '; nextPutAll: testSelector; nextPutLine:' =='.
 
   168                 outputFile readingFileDo:[:s|
 
   168 		outputFile readingFileDo:[:s|
 
   169                     [ s atEnd ] whileFalse:[ 
   169 		    [ s atEnd ] whileFalse:[
 
   170                         Stdout nextPutLine: s nextLine.
 
   170 			Stdout nextPutLine: s nextLine.
 
   171                     ].
 
   171 		    ].
 
   172                 ].
 
   172 		].
 
   173             ].
 
   173 	    ].
 
   174             self assert: false description: 'Assertion failed, see log'.
 
   174 	    self assert: false description: 'Assertion failed, see log'.
 
   175         ].
 
   175 	].
 
   176         (status code == EXIT_CODE_ERROR or:[status status == #signal]) ifTrue:[ 
   176 	(status code == EXIT_CODE_ERROR or:[status status == #signal]) ifTrue:[
 
   177             (outputFile notNil and:[ outputFile exists ]) ifTrue:[ 
   177 	    (outputFile notNil and:[ outputFile exists ]) ifTrue:[
 
   178                 Stdout nextPutAll: '== TEST ERROR: '; nextPutAll: testSelector; nextPutLine:' =='.
 
   178 		Stdout nextPutAll: '== TEST ERROR: '; nextPutAll: testSelector; nextPutLine:' =='.
 
   179                 outputFile readingFileDo:[:s|
 
   179 		outputFile readingFileDo:[:s|
 
   180                     [ s atEnd ] whileFalse:[ 
   180 		    [ s atEnd ] whileFalse:[
 
   181                         Stdout nextPutLine: s nextLine.
 
   181 			Stdout nextPutLine: s nextLine.
 
   182                     ].
 
   182 		    ].
 
   183                 ].
 
   183 		].
 
   184             ].
 
   184 	    ].
 
   185             self error: 'Error occured'.
 
   185 	    self error: 'Error occured'.
 
   186         ].
 
   186 	].
 
   187     ] ensure:[ 
   187     ] ensure:[
 
   188         (tempDir notNil and:[tempDir exists]) ifTrue:[ 
   188 	(tempDir notNil and:[tempDir exists]) ifTrue:[
 
   189             [
 
   189 	    [
 
   190                 tempDir recursiveRemove.
 
   190 		tempDir recursiveRemove.
 
   191             ] on: Error do:[:ex |  
   191 	    ] on: Error do:[:ex |
 
   192                 OperatingSystem isMSWINDOWSlike ifFalse:[ 
   192 		OperatingSystem isMSWINDOWSlike ifFalse:[
 
   193                     ex reject.
 
   193 		    ex reject.
 
   194                 ].
 
   194 		].
 
   195             ]
 
   195 	    ]
 
   196         ].
 
   196 	].
 
   197     ].
 
   197     ].
 
   198 
   198 
   199     "
 
   199     "
 
   200     VMCrashTestCase run:#test_infrastructure
 
   200     VMCrashTestCase run:#test_infrastructure
 
   201     "
 
   201     "
 
   204     "Modified: / 19-09-2014 / 16:43:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   204     "Modified: / 19-09-2014 / 16:43:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   205 !
 
   205 !
 
   206 
   206 
   207 runCaseInternal
 
   207 runCaseInternal
 
   208     [
 
   208     [
 
   209         super runCase.
 
   209 	super runCase.
 
   210         Stdout cr;
 
   210 	Stdout cr;
 
   211             nextPutAll: 'PASSED'; cr.
 
   211 	    nextPutAll: 'PASSED'; cr.
 
   212     ] on: TestResult failure do:[:failure |
 
   212     ] on: TestResult failure do:[:failure |
 
   213         Stdout cr;
 
   213 	Stdout cr;
 
   214             nextPutAll: 'FAILURE: '; nextPutAll: failure description; cr.
 
   214 	    nextPutAll: 'FAILURE: '; nextPutAll: failure description; cr.
 
   215         Smalltalk exit: EXIT_CODE_FAILURE.
 
   215 	Smalltalk exit: EXIT_CODE_FAILURE.
 
   216     ] on: TestResult exError do:[:error |
 
   216     ] on: TestResult exError do:[:error |
 
   217         Stdout cr;
 
   217 	Stdout cr;
 
   218             nextPutAll: 'ERROR: '; nextPutAll: error description; cr.
 
   218 	    nextPutAll: 'ERROR: '; nextPutAll: error description; cr.
 
   219         Smalltalk exit: EXIT_CODE_ERROR.
 
   219 	Smalltalk exit: EXIT_CODE_ERROR.
 
   220     ].
 
   220     ].
 
   221 
   221 
   222     "Created: / 04-09-2014 / 17:41:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   222     "Created: / 04-09-2014 / 17:41:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   223     "Modified: / 05-09-2014 / 18:37:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   223     "Modified: / 05-09-2014 / 18:37:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   224 ! !
 
   224 ! !
 
   247     self assert: result passedCount = 0.
 
   247     self assert: result passedCount = 0.
 
   248     self assert: result failureCount = 0.
 
   248     self assert: result failureCount = 0.
 
   249     self assert: result errorCount = 1.
 
   249     self assert: result errorCount = 1.
 
   250 
   250 
   251     "
 
   251     "
 
   252     VMCrashTestCase run: #tst_crash.      
   252     VMCrashTestCase run: #tst_crash.
 
   253     "
 
   253     "
 
   254     result := self class run: #tst_crash.
 
   254     result := self class run: #tst_crash.
 
   255     self assert: result passedCount = 0.
 
   255     self assert: result passedCount = 0.
 
   256     self assert: result failureCount = 0.
 
   256     self assert: result failureCount = 0.
 
   257     self assert: result errorCount = 1.
 
   257     self assert: result errorCount = 1.
 
   261 !
 
   261 !
 
   262 
   262 
   263 tst_crash
 
   263 tst_crash
 
   264 
   264 
   265     <spawn: true>
 
   265     <spawn: true>
 
   266     
   266 
   267     | bytes | 
   267     | bytes |
 
   268 
   268 
   269     Stdout nextPutLine: 'Going to crash now!!'.
 
   269     Stdout nextPutLine: 'Going to crash now!!'.
 
   270 
   270 
   271     bytes := ExternalBytes address: 16r10 size: 100.
 
   271     bytes := ExternalBytes address: 16r10 size: 100.
 
   272     bytes byteAt: 1 put: 10.
 
   272     bytes byteAt: 1 put: 10.
 
   289 
   289 
   290     "Created: / 05-09-2014 / 18:20:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   290     "Created: / 05-09-2014 / 18:20:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   291     "Modified: / 08-09-2014 / 12:26:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   291     "Modified: / 08-09-2014 / 12:26:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   292 !
 
   292 !
 
   293 
   293 
   294 tst_pass    
   294 tst_pass
 
   295     <spawn: true>
 
   295     <spawn: true>
 
   296 
   296 
   297     "Created: / 05-09-2014 / 18:20:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   297     "Created: / 05-09-2014 / 18:20:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   298     "Modified: / 08-09-2014 / 12:26:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   298     "Modified: / 08-09-2014 / 12:26:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   299 ! !
 
   299 ! !
hg/stx-goodies-regression