diff -r e0bb91eae748 -r 59de21f18945 Block.st --- 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)." + + + + + + |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$' ! !