Mercurial Mercurial > hg > stx-libbasic / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Block.st
changeset 18959 59de21f18945
parent 18434 6d5f0280a7c7
child 18960 6e6225b7a7d9
child 18992 5df345494151 
--- a/Block.st	Wed Nov 25 19:52:01 2015 +0100
+++ b/Block.st	Thu Nov 26 13:54:35 2015 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
 "
  COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
@@ -860,7 +858,7 @@
 
     Transcript show:anInfoString.
     micros < 1000 ifTrue:[
-	Transcript show:micros; show:' µs'.
+	Transcript show:micros; show:' µs'.
     ] ifFalse:[
 	micros < 100000 ifTrue:[
 	    millis := (micros / 1000.0) asFixedPointRoundedToScale:2.
@@ -2174,6 +2172,65 @@
     "
 !
 
+on:aSignalOrSignalSetOrException do:exceptionBlock ifCurtailed:curtailBlock
+    "evaluate the receiver,
+     handling aSignalOrSignalSetOrException.
+     The 2nd argument, exceptionBlock is evaluated
+     if the signal is raised during evaluation.
+     The 3rd argument, curtailBlock is evaluated if the activity
+     was unwound due to an unhandled exception in the receiver block
+     (but not in the exceptionBlock)."
+
+    <context: #return>
+    <exception: #handle>
+    <exception: #unwind>
+
+    |v|
+
+    v := self value.       "the real logic is in Context>>unwind and Exception>>doRaise"
+    thisContext unmarkForUnwind.
+    ^ v
+
+    "
+     |e|
+
+     e := 0.
+     [
+        1 foo
+     ] on:MessageNotUnderstood
+     do:[:ex | e := 1]
+     ifCurtailed:[ e := 2 ].
+     self assert:(e == 1).
+    "
+
+    "
+     abort the debugger to perform the ifCurtailedBlock...
+     continue the debugger to go to the end   
+
+     |e|
+
+     e := 0.
+     [
+        #[] at:2
+     ] on:MessageNotUnderstood
+     do:[:ex | e := 1]
+     ifCurtailed:[ e := 2. e inspect ].
+     self assert:(e == 0).
+    "
+
+    "
+     |e|
+
+     e := 0.
+     [
+        1 negated
+     ] on:MessageNotUnderstood
+     do:[:ex | self halt]
+     ifCurtailed:[ e := 1 ].
+     self assert:(e == 0).
+    "
+!
+
 on:anExceptionHandler do:exceptionBlock on:anExceptionHandler2 do:anExceptionBlock2
     "added for ANSI compatibility; evaluate the receiver,
      handling aSignalOrSignalSetOrException.
@@ -2359,84 +2416,89 @@
     ^ aContext argAt:1.
 !
 
-handlerForSignal:exceptionHandler context:theContext originator:originator
-    "answer the handler block for the exceptionHandler from originator.
+handlerForSignal:exceptionCreator context:theContext originator:originator
+    "answer the handler block for the exceptionCreator from originator.
      The handler block is retrieved from aContext.
-     Answer nil if the exceptionHandler is not handled."
+     Answer nil if the exceptionCreator is not handled."
 
     |selector exceptionHandlerInContext|
 
     selector := theContext selector.
 
     (selector == #on:do:
-    or:[ selector == #on:do:ensure: ]) ifTrue:[
-	exceptionHandlerInContext := theContext argAt:1.
-	exceptionHandlerInContext isExceptionHandler ifFalse:[
-	    exceptionHandlerInContext isNil ifTrue:[
-		'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR.
-	    ] ifFalse:[(exceptionHandlerInContext isBehavior
-			and:[exceptionHandlerInContext isLoaded not]) ifTrue:[
-		"If the exception class is still autoloaded,
-		 it does not accept our exception. Raising the exception would load the class"
-		^ nil
-	    ] ifFalse:[
-		'Block [warning]: non-ExceptionHandler in on:do:-context' errorPrintCR.
-	    ]].
-	    theContext fullPrint.
-	    ^ nil.
-	].
-	(exceptionHandlerInContext == exceptionHandler
-	 or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[
-	    ^ (theContext argAt:2) ? [nil].
-	].
-	^ nil
+     or:[ selector == #on:do:ensure: 
+     or:[ selector == #on:do:ifCurtailed: ]]
+     ) ifTrue:[
+        exceptionHandlerInContext := theContext argAt:1.
+        exceptionHandlerInContext isExceptionHandler ifFalse:[
+            exceptionHandlerInContext isNil ifTrue:[
+                'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR.
+            ] ifFalse:[(exceptionHandlerInContext isBehavior
+                        and:[exceptionHandlerInContext isLoaded not]) ifTrue:[
+                "If the exception class is still autoloaded,
+                 it does not accept our exception. Raising the exception would load the class"
+                ^ nil
+            ] ifFalse:[
+                'Block [warning]: non-ExceptionHandler in on:do:-context' errorPrintCR.
+            ]].
+            theContext fullPrint.
+            ^ nil.
+        ].
+        (exceptionHandlerInContext == exceptionCreator
+         or:[exceptionHandlerInContext accepts:exceptionCreator]) ifTrue:[
+            selector == #on:do:ifCurtailed: ifTrue:[
+                theContext unmarkForUnwind.     "if there is a handler, no unwind block has to be performed"
+            ].
+            ^ (theContext argAt:2) ? [nil].
+        ].
+        ^ nil
     ].
 
     selector == #on:do:on:do: ifTrue:[
-	exceptionHandlerInContext := theContext argAt:1.
-	exceptionHandlerInContext isExceptionHandler ifFalse:[
-	    exceptionHandlerInContext isNil ifTrue:[
-		'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR.
-	    ] ifFalse:[(exceptionHandlerInContext isBehavior
-			and:[exceptionHandlerInContext isLoaded not]) ifTrue:[
-		"If the exception class is still autoloaded,
-		 it does not accept our exception. Raising the exception would load the class"
-		^ nil
-	    ] ifFalse:[
-		'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR.
-	    ]].
-	    theContext fullPrint.
-	    ^ nil.
-	].
-	(exceptionHandlerInContext == exceptionHandler
-	 or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[
-	    ^ (theContext argAt:2) ? [nil].
-	].
-
-	exceptionHandlerInContext := theContext argAt:3.
-	exceptionHandlerInContext isExceptionHandler ifFalse:[
-	    exceptionHandlerInContext isNil ifTrue:[
-		'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR.
-	    ] ifFalse:[(exceptionHandlerInContext isBehavior
-			and:[exceptionHandlerInContext isLoaded not]) ifTrue:[
-		"If the exception class is still autoloaded,
-		 it does not accept our exception. Raising the exception would load the class"
-		^ nil
-	    ] ifFalse:[
-		'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR.
-	    ]].
-	    theContext fullPrint.
-	    ^ nil.
-	].
-	(exceptionHandlerInContext == exceptionHandler
-	 or:[exceptionHandlerInContext accepts:exceptionHandler]) ifTrue:[
-	    ^ (theContext argAt:4) ? [nil].
-	].
-	^ nil
+        exceptionHandlerInContext := theContext argAt:1.
+        exceptionHandlerInContext isExceptionHandler ifFalse:[
+            exceptionHandlerInContext isNil ifTrue:[
+                'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR.
+            ] ifFalse:[(exceptionHandlerInContext isBehavior
+                        and:[exceptionHandlerInContext isLoaded not]) ifTrue:[
+                "If the exception class is still autoloaded,
+                 it does not accept our exception. Raising the exception would load the class"
+                ^ nil
+            ] ifFalse:[
+                'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR.
+            ]].
+            theContext fullPrint.
+            ^ nil.
+        ].
+        (exceptionHandlerInContext == exceptionCreator
+         or:[exceptionHandlerInContext accepts:exceptionCreator]) ifTrue:[
+            ^ (theContext argAt:2) ? [nil].
+        ].
+
+        exceptionHandlerInContext := theContext argAt:3.
+        exceptionHandlerInContext isExceptionHandler ifFalse:[
+            exceptionHandlerInContext isNil ifTrue:[
+                'Block [warning]: nil ExceptionHandler in on:do:on:do:-context' errorPrintCR.
+            ] ifFalse:[(exceptionHandlerInContext isBehavior
+                        and:[exceptionHandlerInContext isLoaded not]) ifTrue:[
+                "If the exception class is still autoloaded,
+                 it does not accept our exception. Raising the exception would load the class"
+                ^ nil
+            ] ifFalse:[
+                'Block [warning]: non-ExceptionHandler in on:do:on:do:-context' errorPrintCR.
+            ]].
+            theContext fullPrint.
+            ^ nil.
+        ].
+        (exceptionHandlerInContext == exceptionCreator
+         or:[exceptionHandlerInContext accepts:exceptionCreator]) ifTrue:[
+            ^ (theContext argAt:4) ? [nil].
+        ].
+        ^ nil
     ].
 
     selector == #valueWithExceptionHandler: ifTrue:[
-	^ (theContext argAt:1) handlerForSignal:exceptionHandler.
+        ^ (theContext argAt:1) handlerForSignal:exceptionCreator.
     ].
 
     "/ mhmh - should not arrive here
@@ -3085,10 +3147,11 @@
 
     selector := aContext selector.
     selector == #'value:onUnwindDo:' ifTrue:[
-	^ aContext argAt:2
+        ^ aContext argAt:2
     ].
-    selector == #'on:do:ensure:' ifTrue:[
-	^ aContext argAt:3
+    (selector == #'on:do:ensure:'
+     or:[selector == #'on:do:ifCurtailed:'])ifTrue:[
+        ^ aContext argAt:3
     ].
 
     "/ for now, only #valueNowOrOnUnwindDo:
@@ -3234,11 +3297,11 @@
 !Block class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.213 2015-06-05 16:08:43 stefan Exp $'
+    ^ '$Header$'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.213 2015-06-05 16:08:43 stefan Exp $'
+    ^ '$Header$'
 ! !
hg/stx-libbasic