"
 COPYRIGHT (c) 2017 Jan Vrany
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:goodies/regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#ProcessSpawningTestCase
	instanceVariableNames:'process threads threadsBlocker failureSignaller failure'
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression-Abstract'
!

!ProcessSpawningTestCase class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2017 Jan Vrany
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
! !

!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>"
! !