*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Fri, 24 Sep 2004 10:19:31 +0200
changeset 249 883b35584076
parent 248 0441d79812e8
child 250 619351b79902
*** empty log message ***
RegressionTests__ContextTest2.st
--- a/RegressionTests__ContextTest2.st	Tue Sep 21 14:32:59 2004 +0200
+++ b/RegressionTests__ContextTest2.st	Fri Sep 24 10:19:31 2004 +0200
@@ -2,20 +2,27 @@
 
 "{ NameSpace: RegressionTests }"
 
-nil subclass:#ContextTest2
+TestCase subclass:#ContextTest2
+	instanceVariableNames:'exceptionObject'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'tests-Regression'
+!
+
+Notification subclass:#MyNotification
 	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
-	category:'tests-Regression'
+	privateIn:ContextTest2
 !
 
 
 !ContextTest2 methodsFor:'helpers'!
 
 downToNextSegmentThenDo:aBlock
-    self 
-        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
-        thenDo:aBlock
+    self
+	downToSegment:(Processor activeProcess numberOfStackSegments + 1)
+	thenDo:aBlock
 
     "
      self new testUnwind1
@@ -23,9 +30,9 @@
 !
 
 downToNextSegmentThenUnwindAndDo:aBlock
-    self 
-        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
-        thenUnwindAndDo:aBlock
+    self
+	downToSegment:(Processor activeProcess numberOfStackSegments + 1)
+	thenUnwindAndDo:aBlock
 
     "
      self new testUnwind2
@@ -34,11 +41,11 @@
 
 downToSegment:nr thenDo:aBlock
     Processor activeProcess numberOfStackSegments >= nr ifTrue:[
-        ^  aBlock value
+	^  aBlock value
     ].
-    self 
-        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
-        thenDo:aBlock
+    self
+	downToSegment:(Processor activeProcess numberOfStackSegments + 1)
+	thenDo:aBlock
 
     "
      self new testUnwind1
@@ -47,17 +54,21 @@
 
 downToSegment:nr thenUnwindAndDo:aBlock
     Processor activeProcess numberOfStackSegments >= nr ifTrue:[
-        aBlock home unwindThenDo: aBlock
+	aBlock home unwindThenDo: aBlock
     ].
-    self 
-        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
-        thenUnwindAndDo:aBlock
+    self
+	downToSegment:(Processor activeProcess numberOfStackSegments + 1)
+	thenUnwindAndDo:aBlock
 
     "
      self new testUnwind2
     "
 !
 
+exceptionObjectIs:ex
+    exceptionObject := ex
+!
+
 getAssocWithContext
     ^ self getSendersContext -> #foo
 !
@@ -66,6 +77,26 @@
     ^ 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
 !
@@ -119,7 +150,7 @@
 testContextRef3
     AbortOperationRequest handle:[:ex |
     ] do:[
-        self raiseWithContext.
+	self raiseWithContext.
     ].
     ObjectMemory garbageCollect.
 
@@ -132,11 +163,11 @@
     |con|
 
     AbortOperationRequest handle:[:ex |
-        ObjectMemory garbageCollect.
-        con := ex parameter.
-        ObjectMemory garbageCollect.
+	ObjectMemory garbageCollect.
+	con := ex parameter.
+	ObjectMemory garbageCollect.
     ] do:[
-        self raiseWithContext.
+	self raiseWithContext.
     ].
     ObjectMemory garbageCollect.
 
@@ -172,6 +203,17 @@
     "
 !
 
+testContextRef8
+    100000 timesRepeat:[
+        self raiseNotification.
+        self assert:(ObjectMemory spaceOf:exceptionObject suspendedContext) < 4.
+    ].
+
+    "
+     self new testContextRef8
+    "
+!
+
 testProcess1
     |x set lockSet p arg|
 
@@ -183,12 +225,12 @@
     arg := x.
 
     p := [
-        [
-            lockSet critical:[set add:arg].
-            arg perform:#x .
-        ] valueNowOrOnUnwindDo:[
-            lockSet critical:[set remove:arg].
-        ].
+	[
+	    lockSet critical:[set add:arg].
+	    arg perform:#x .
+	] valueNowOrOnUnwindDo:[
+	    lockSet critical:[set remove:arg].
+	].
     ] fork.
 
     "
@@ -205,12 +247,12 @@
     x := 1 @ 1.
 
     p := [:arg |
-        [
-            lockSet critical:[set add:arg].
-            arg perform:#x.
-        ] valueNowOrOnUnwindDo:[
-            lockSet critical:[set remove:arg].
-        ].
+	[
+	    lockSet critical:[set add:arg].
+	    arg perform:#x.
+	] valueNowOrOnUnwindDo:[
+	    lockSet critical:[set remove:arg].
+	].
     ] forkWith:(Array with:x).
 
     "
@@ -227,12 +269,12 @@
     x := 1 @ 1.
 
     p := [:arg |
-        [
-            lockSet critical:[set add:arg].
-            arg perform:#x: with:1234.
-        ] valueNowOrOnUnwindDo:[
-            lockSet critical:[set remove:arg].
-        ].
+	[
+	    lockSet critical:[set add:arg].
+	    arg perform:#x: with:1234.
+	] valueNowOrOnUnwindDo:[
+	    lockSet critical:[set remove:arg].
+	].
     ] forkWith:(Array with:x).
 
     "
@@ -286,6 +328,24 @@
     "
 ! !
 
+!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