"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

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

Notification subclass:#MyNotification
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:ContextTest2
!


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

exceptionObjectIs:ex
    exceptionObject := ex
!

getAssocWithContext
    ^ self getSendersContext -> #foo
!

getSendersContext
    ^ thisContext sender
!

raiseNotification
    NoHandlerError handle:[:ex |
        ex return
    ] do:[
        |t|

%{
  extern void *__contextToDebug__;
  __contextToDebug__ = (void *)__thisContext;
%}.
        t := MyNotification raiseRequestFrom:self.
%{
  extern void *__contextToDebug__;
  __contextToDebug__ = (void *)__thisContext;
%}.
        ^ t
    ].
    ^ nil.
!

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

testContextRef8
    100000 timesRepeat:[
        self raiseNotification.
        self assert:(ObjectMemory spaceOf:exceptionObject suspendedContext) < 4.
    ].

    "
     self new testContextRef8
    "
!

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::MyNotification class methodsFor:'raising'!

raiseRequestFrom:someone
    "raise a signal proceedable.
     The argument, something is passed both as parameter and originator."

    <context: #return>

    |ex|

    ex := self newExceptionFrom:someone.
someone exceptionObjectIs:ex.
    ^ (ex
        suspendedContext:thisContext sender
        parameter:someone)
            raiseRequest.
! !

!ContextTest2 class methodsFor:'documentation'!

version
    ^ '$Header$'
! !