#FEATURE
class: Block
added: #on:do:ifCurtailed:
changed:
#handlerForSignal:context:originator:
#unwindHandlerInContext:
--- 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$'
! !