"{ Package: 'stx:goodies/regression' }"
"{ NameSpace: RegressionTests }"
TestCase subclass:#ProcessSpawningTestCase
instanceVariableNames:'process threads threadsBlocker failureSignaller failure'
classVariableNames:''
poolDictionaries:''
category:'tests-Regression-Abstract'
!
!ProcessSpawningTestCase methodsFor:'private'!
performTest
| blocker |
self assert: threadsBlocker notNil.
self assert: failureSignaller notNil.
blocker := SemaphoreSet with: threadsBlocker with: failureSignaller.
super performTest.
blocker wait.
failure notNil ifTrue:[
(failure value isKindOf: TestResult failure) ifTrue:[
self assert: false description: (failure value description , ' in ', failure key printString)
] ifFalse:[
self error: (failure value description , ' in ', failure key printString)
].
]
"Created: / 28-08-2017 / 12:18:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-08-2017 / 20:50:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProcessSpawningTestCase methodsFor:'running'!
setUp
Smalltalk addDependent: self.
process := Processor activeProcess.
threads := Set new.
threadsBlocker := (Semaphore new:1) name: 'threadsBlocker for ', self printString.
failureSignaller := (Semaphore new) name: 'failureSignaller for ', self printString.
MessageTracer mock: #newProcess in: Block do: [ :receiver :method |
| process |
process := method valueWithReceiver: receiver arguments: #().
process addExitAction:[ threadsBlocker notNil ifTrue:[ threadsBlocker signal ] ].
process emergencySignalHandler:[ :ex | failure := process -> ex parameter. failureSignaller notNil ifTrue:[ failureSignaller signal ] ].
threadsBlocker setCount: threadsBlocker count - 1.
process.
].
"
ThreadSpawningTestCase debug: #TEST_02.
"
"Created: / 28-08-2017 / 10:08:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-08-2017 / 20:39:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
tearDown
MessageTracer unmock: #newProcess in: Block.
process := nil.
threadsBlocker := nil.
failureSignaller := nil.
threads do:[:thread |
thread isDead ifFalse:[ thread terminate ]
].
"Created: / 28-08-2017 / 11:22:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-08-2017 / 20:32:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProcessSpawningTestCase methodsFor:'tests - infrastructure'!
TEST_error
[
self perform: #quz
] fork
"
ProcessSpawningTestCase debug: #TEST_error
"
"Created: / 28-08-2017 / 20:41:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
TEST_failure
[
self assert: false.
] fork
"
ProcessSpawningTestCase debug: #TEST_failure
"
"Created: / 28-08-2017 / 20:40:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
TEST_pass
[
self assert: true.
] fork
"
ProcessSpawningTestCase debug: #TEST_pass
"
"Created: / 28-08-2017 / 20:40:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_infrastructre
| result |
result := (ProcessSpawningTestCase selector:#'TEST_pass') run.
self assert:result passedCount == 1.
self assert:result failureCount == 0.
self assert:result errorCount == 0.
result := (ProcessSpawningTestCase selector:#'TEST_failure') run.
self assert:result passedCount == 0.
self assert:result failureCount == 1.
self assert:result errorCount == 0.
result := (ProcessSpawningTestCase selector:#'TEST_error') run.
self assert:result passedCount == 0.
self assert:result failureCount == 0.
self assert:result errorCount == 1.
"
ProcessSpawningTestCase run: #test_infrastructre
ProcessSpawningTestCase debug: #test_infrastructre
"
"Created: / 28-08-2017 / 20:42:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !