"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

nil subclass:#ContextTest2
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression'
!


!ContextTest2 methodsFor:'helpers'!

downToNextSegmentThenDo:aBlock
    self 
        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
        thenDo:aBlock

    "
     self new testUnwind1
    "
!

downToNextSegmentThenUnwindAndDo:aBlock
    self 
        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
        thenUnwindAndDo:aBlock

    "
     self new testUnwind2
    "
!

downToSegment:nr thenDo:aBlock
    Processor activeProcess numberOfStackSegments >= nr ifTrue:[
        ^  aBlock value
    ].
    self 
        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
        thenDo:aBlock

    "
     self new testUnwind1
    "
!

downToSegment:nr thenUnwindAndDo:aBlock
    Processor activeProcess numberOfStackSegments >= nr ifTrue:[
        aBlock home unwindThenDo: aBlock
    ].
    self 
        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
        thenUnwindAndDo:aBlock

    "
     self new testUnwind2
    "
!

getAssocWithContext
    ^ self getSendersContext -> #foo
!

getSendersContext
    ^ thisContext sender
!

raiseWithContext
    AbortOperationRequest raiseWith:self getSendersContext
!

selfReferringContext
    |ref|

    ref := thisContext.
    ^ thisContext
!

senderContext
    ^ thisContext sender
!

senderReferringContext1
    ^ self senderReferringContext:thisContext
!

senderReferringContext2
    ^ self senderContext
!

senderReferringContext:aContext
    ^ aContext
! !

!ContextTest2 methodsFor:'tests'!

testContextRef1
    |assoc|

    assoc := self getAssocWithContext.
    ObjectMemory garbageCollect.

    "
     self new testContextRef1
    "
!

testContextRef2

    self getAssocWithContext.
    ObjectMemory garbageCollect.

    "
     self new testContextRef2
    "
!

testContextRef3
    AbortOperationRequest handle:[:ex |
    ] do:[
        self raiseWithContext.
    ].
    ObjectMemory garbageCollect.

    "
     self new testContextRef3
    "
!

testContextRef4
    |con|

    AbortOperationRequest handle:[:ex |
        ObjectMemory garbageCollect.
        con := ex parameter.
        ObjectMemory garbageCollect.
    ] do:[
        self raiseWithContext.
    ].
    ObjectMemory garbageCollect.

    "
     self new testContextRef4
    "
!

testContextRef5
    self selfReferringContext.
    ObjectMemory garbageCollect.

    "
     self new testContextRef5
    "
!

testContextRef6
    self senderReferringContext1.
    ObjectMemory garbageCollect.

    "
     self new testContextRef6
    "
!

testContextRef7
    self senderReferringContext2.
    ObjectMemory garbageCollect.

    "
     self new testContextRef7
    "
!

testProcess1
    |x set lockSet p arg|

    lockSet := Semaphore forMutualExclusion.
    set := Set new.

    x := 1 @ 1.

    arg := x.

    p := [
        [
            lockSet critical:[set add:arg].
            arg perform:#x .
        ] valueNowOrOnUnwindDo:[
            lockSet critical:[set remove:arg].
        ].
    ] fork.

    "
     self new testProcess1
    "
!

testProcess2
    |x set lockSet p|

    lockSet := Semaphore forMutualExclusion.
    set := Set new.

    x := 1 @ 1.

    p := [:arg |
        [
            lockSet critical:[set add:arg].
            arg perform:#x.
        ] valueNowOrOnUnwindDo:[
            lockSet critical:[set remove:arg].
        ].
    ] forkWith:(Array with:x).

    "
     self new testProcess2
    "
!

testProcess3
    |x set lockSet p|

    lockSet := Semaphore forMutualExclusion.
    set := Set new.

    x := 1 @ 1.

    p := [:arg |
        [
            lockSet critical:[set add:arg].
            arg perform:#x: with:1234.
        ] valueNowOrOnUnwindDo:[
            lockSet critical:[set remove:arg].
        ].
    ] forkWith:(Array with:x).

    "
     self new testProcess3
    "
!

testUnwind1
    Transcript showCR:'1'.
    self downToNextSegmentThenDo:[Transcript showCR:'2'. ^  self ].
    Transcript showCR:'3'.

    "
     self new testUnwind1
    "
!

testUnwind2
    Transcript showCR:'1'.
    self downToNextSegmentThenUnwindAndDo:[Transcript showCR:'2'. ^  self ].
    Transcript showCR:'3'.

    "
     self new testUnwind2
    "
!

testUnwind3
    <context: #return>

    |foo|

    Transcript showCR:'1'.
    self downToNextSegmentThenUnwindAndDo:[Transcript showCR:'2'. foo := #foo ].
    Transcript showCR:'3'.

    "
     self new testUnwind3
    "
!

testUnwind4
    |foo|

    Transcript showCR:'1'.
    self downToNextSegmentThenDo:[Transcript showCR:'2'. foo := #foo ].
    Transcript showCR:'3'.

    "
     self new testUnwind4
    "
! !

!ContextTest2 class methodsFor:'documentation'!

version
    ^ '$Header$'
! !