"{ Encoding: utf8 }"

"{ Package: 'stx:goodies/regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#ContextTest2

	instanceVariableNames:'exceptionObject ttt'

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression-RuntimeSystem'

!

Notification subclass:#MyNotification

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:ContextTest2

!

!ContextTest2 methodsFor:'helpers'!

call10_1

    |local|

    ^ self call10_2:[:x | local := x].

!

call10_2:aBlock

    |local|

    local := 2.

    ^ self call10_3:aBlock

    "Modified: / 02-08-2017 / 14:03:32 / stefan"

!

call10_3:aBlock

    |local|

    local := 3.

    aBlock value:thisContext.

    ^ thisContext sender sender

    "Modified: / 02-08-2017 / 14:04:19 / stefan"

!

call11_1

    |local|

    self call11_2:[:x | local := x].

    ^ local value.

!

call11_2:aBlock

    ^ self call11_3:aBlock

!

call11_3:aBlock

    aBlock value:[thisContext].

    ^ thisContext sender sender

!

call9_1

    ^ self call9_2

!

call9_2

    ^ self call9_3

!

call9_3

    ttt := thisContext.

    ^ ttt sender sender

!

callRecursive: level withArg:argument thenDo:aBlock

    level == 0 ifTrue:[

	aBlock value:thisContext.

	^ self.

    ].

    self callRecursive:level-1 withArg:argument thenDo:aBlock

    "Created: / 07-03-2012 / 13:04:48 / cg"

!

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

    "

!

testContextRef10

    |val|

    val := self call10_1.

    ObjectMemory dumpObject:val.

    ObjectMemory dumpObject:(val varAt:1).

    ObjectMemory dumpObject:((val varAt:1) varAt:1).

    "

     self new testContextRef10

    "

!

testContextRef11

    |val|

    val := self call10_1.

    ObjectMemory dumpObject:val.

    "

     self new testContextRef11

    "

!

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

    "

!

testContextRef9

    |val|

    val := self call9_1.

    ObjectMemory dumpObject:val.

    ObjectMemory dumpObject:ttt.

    "

     self new testContextRef9

    "

!

testDisplayString1

    "the generated displayString must be a string (even if one of the args or receiver

     is a Twobytestring"

    Transcript showCR:'1'.

    self

        callRecursive:3

        withArg:((Unicode16String new:2)

                                at:1 put:(Character value:16r151);

                                at:2 put:(Character value:16rFF00);

                                yourself)

        thenDo:[:context |

                    self assert:(context displayString bitsPerCharacter == 8).

"/                    self assert:(context fullPrintString bitsPerCharacter == 8).

               ].

    "

     self new testDisplayString1

    "

    "Created: / 07-03-2012 / 13:03:32 / cg"

    "Modified: / 02-08-2017 / 14:11:41 / stefan"

!

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 .

	] ensure:[

	    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.

	] ensure:[

	    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.

	    lockSet critical:[set rehash].

	] ensure:[

	    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 newException.

someone exceptionObjectIs:ex.

    ^ (ex

	suspendedContext:thisContext sender

	parameter:someone originator:someone)

	    raiseRequest.

! !

!ContextTest2 class methodsFor:'documentation'!

version

    ^ '$Header$'

! !