--- a/Block.st Sat Jan 25 21:55:08 2020 +0000
+++ b/Block.st Wed May 20 18:34:29 2020 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
COPYRIGHT (c) 2015 Jan Vrany
@@ -17,7 +19,7 @@
CompiledCode variableSubclass:#Block
instanceVariableNames:'home nargs sourcePos initialPC'
- classVariableNames:'InvalidNewSignal'
+ classVariableNames:''
poolDictionaries:''
category:'Kernel-Methods'
!
@@ -88,9 +90,9 @@
coll do:[:eachElement | Transcript showCR:eachElement ].
Blocks keep a reference to the context where it was declared -
- this allows blocks to access the methods arguments and/or variables.
+ this allows blocks to access the method's arguments and/or variables.
This is still true after the method has returned - since the
- block keeps this reference, the methods context will NOT die in this case.
+ block keeps this reference, the method's context will NOT die in this case.
(for experts: Smalltalk blocks are technically lambdas/closures)
A return (via ^-statement) out of a block will force a return from the
@@ -337,20 +339,6 @@
"
! !
-!Block class methodsFor:'initialization'!
-
-initialize
- "create signals raised by various errors"
-
- InvalidNewSignal isNil ifTrue:[
- InvalidNewSignal := Error newSignalMayProceed:false.
- InvalidNewSignal nameClass:self message:#invalidNewSignal.
- InvalidNewSignal notifierString:'blocks are only created by the system'.
- ]
-
- "Modified: 22.4.1996 / 16:34:20 / cg"
-! !
-
!Block class methodsFor:'instance creation'!
byteCode:bCode numArgs:numArgs numStack:nStack sourcePosition:sourcePos initialPC:initialPC literals:literals
@@ -365,17 +353,15 @@
"create a new cheap (homeless) block.
Not for public use - this is a special hook for the compiler."
- |newBlock|
-
- newBlock := (super basicNew:(literals size))
+ ^ (self basicNew:literals size)
byteCode:bCode
numArgs:numArgs
numVars:numVars
numStack:nStack
sourcePosition:sourcePos
initialPC:initialPC
- literals:literals.
- ^ newBlock
+ literals:literals;
+ yourself.
"Modified: 24.6.1996 / 12:36:48 / stefan"
"Created: 13.4.1997 / 00:04:09 / cg"
@@ -386,13 +372,13 @@
If you really need a block (assuming, you are some compiler),
use basicNew and setup the instance carefully"
- ^ InvalidNewSignal raise.
+ ^ MethodNotAppropriateError raiseErrorString:'blocks are only created by the system'.
!
new:size
"catch creation of blocks - only the system creates blocks"
- ^ InvalidNewSignal raise.
+ ^ MethodNotAppropriateError raiseErrorString:'blocks are only created by the system'.
! !
!Block class methodsFor:'queries'!
@@ -407,6 +393,7 @@
! !
+
!Block methodsFor:'Compatibility-ANSI'!
argumentCount
@@ -532,7 +519,7 @@
"activate the receiver with one or zero arguments.
Squeak compatibility, but also present in VW Smalltalk"
- nargs >= 1 ifTrue:[^ self value:optionalFirstArg].
+ nargs > 0 ifTrue:[^ self value:optionalFirstArg].
^ self value
!
@@ -541,7 +528,7 @@
Squeak compatibility, but also present in VW Smalltalk"
nargs >= 2 ifTrue:[^ self value:optionalFirstArg value:optionalSecondArg].
- nargs = 1 ifTrue:[^ self value:optionalFirstArg].
+ nargs == 1 ifTrue:[^ self value:optionalFirstArg].
^ self value
!
@@ -555,7 +542,7 @@
].
^ self value:optionalFirstArg value:optionalSecondArg
].
- nargs = 1 ifTrue:[^ self value:optionalFirstArg].
+ nargs == 1 ifTrue:[^ self value:optionalFirstArg].
^ self value
!
@@ -570,22 +557,14 @@
|numArgs|
numArgs := handlerBlock isBlock ifTrue:[handlerBlock argumentCount] ifFalse:[0].
- numArgs == 1 ifTrue:[
+ numArgs <= 1 ifTrue:[
^ self on:Error do:handlerBlock
].
^ self
on:Error
do:[:ex |
- |errString errReceiver|
-
- numArgs == 0 ifTrue:[
- ex return:handlerBlock value
- ] ifFalse:[
- errString := ex description.
- errReceiver := ex suspendedContext receiver.
- ex return:(handlerBlock value:errString value:errReceiver)
- ].
+ ex return:(handlerBlock value:ex description value:ex suspendedContext receiver)
]
"
@@ -608,6 +587,8 @@
a := 0.
[ 123 / a ] ifError:[self halt]
"
+
+ "Modified: / 18-03-2017 / 18:19:20 / stefan"
!
timeToRun
@@ -712,7 +693,45 @@
"Created: / 28-08-2010 / 14:41:15 / cg"
! !
-
+!Block methodsFor:'Javascript support'!
+
+_at:index
+ "this is a synthetic selector, generated by the compiler,
+ if a construct of the form expr[idx] is parsed.
+ I.e.
+ foo[n]
+ generates
+ foo _at: n
+ "
+
+ ^ self value:index
+
+ "
+ |double|
+
+ double := [:n | n*2].
+ double[10]
+ "
+!
+
+_at:index1 at:index2
+ "this is a synthetic selector, generated by the compiler,
+ if a construct of the form expr[idx] is parsed.
+ I.e.
+ foo[n][m]
+ generates
+ foo _at:n at:m
+ "
+ ^ self value:index1 value:index2
+
+ "
+ |doubleDiv|
+
+ doubleDiv := [:n :d | n*2/d].
+ doubleDiv[10][3].
+ doubleDiv[10 . 3].
+ "
+! !
!Block methodsFor:'accessing'!
@@ -747,9 +766,11 @@
<resource: #obsolete>
+ self obsoleteMethodWarning:'use #homeMethod'.
^ self homeMethod
- "Modified: 19.6.1997 / 16:15:24 / cg"
+ "Modified: / 19-06-1997 / 16:15:24 / cg"
+ "Modified: / 23-06-2017 / 10:47:00 / stefan"
!
methodHome
@@ -763,11 +784,11 @@
!
numArgs
+ <resource: #obsolete> "/ but left in for a while, for performance and Squeak compatibility
+
"return the number of arguments I expect for evaluation.
Please use argumentCount for ANSI compatibility"
-"/ <resource: #obsolete>
-
^ nargs
! !
@@ -780,10 +801,34 @@
!Block methodsFor:'conversion'!
+asBlock
+ ^ self
+
+ "Created: / 17-05-2019 / 15:09:21 / Claus Gittinger"
+!
+
+asIterator
+ "return myself as an iterator.
+ that is a collection which uses the receiver block to
+ generate the elements."
+
+ ^ Iterator on:self.
+
+ "
+ |coll|
+
+ coll := [:action | 1 to:20 do:action] asIterator.
+ coll do:[:each | Transcript showCR:each].
+ "
+
+ "Created: / 09-02-2019 / 15:31:10 / Claus Gittinger"
+!
+
asVarArgBlock
"convert myself into a varArg block;
this one has 1 formal argument, which gets the list
- of actual arguments when evaluated."
+ of actual arguments when evaluated
+ (similar to rest arg in scheme)."
nargs ~~ 1 ifTrue:[
self error:'vararg blocks must take exactly 1 argument - the arg list'.
@@ -805,8 +850,8 @@
b value:'arg1' value:'arg2' value:'arg3' value:'arg4'
"
- "Created: 23.1.1997 / 13:35:28 / cg"
- "Modified: 23.1.1997 / 13:35:48 / cg"
+ "Created: / 23-01-1997 / 13:35:28 / cg"
+ "Modified (comment): / 28-06-2019 / 12:37:23 / Claus Gittinger"
!
beCurryingBlock
@@ -858,6 +903,14 @@
"Created: 23.1.1997 / 13:35:28 / cg"
"Modified: 23.1.1997 / 13:35:48 / cg"
+!
+
+literalArrayEncoding
+ "I have none"
+
+ ^ nil
+
+ "Created: / 11-02-2019 / 16:50:58 / sr"
! !
!Block methodsFor:'copying'!
@@ -881,11 +934,12 @@
!Block methodsFor:'debugging'!
benchmark:anInfoString
- "evaluate myseld and show the timing info on Transcript"
+ "evaluate myself and show the timing info on Transcript"
|startTime endTime startCycles endCycles overhead overheadCycles
micros millis cycles|
+ "/warmup before executing self
startTime := OperatingSystem getMicrosecondTime.
startCycles := OperatingSystem getCPUCycleCount.
[123] value.
@@ -893,7 +947,7 @@
endTime := OperatingSystem getMicrosecondTime.
overhead := endTime - startTime.
"/ just in case, the OS does not support cpu cycles
- overheadCycles := endCycles - startCycles.
+ startCycles notNil ifTrue:[ overheadCycles := endCycles - startCycles ].
startTime := OperatingSystem getMicrosecondTime.
startCycles := OperatingSystem getCPUCycleCount.
@@ -902,13 +956,16 @@
endTime := OperatingSystem getMicrosecondTime.
micros := (endTime - startTime - overhead) max:0.
+ "/ just in case, the OS does not support cpu cycles
+ startCycles notNil ifTrue:[
cycles := (endCycles - startCycles - overheadCycles) max:0.
+ ].
Transcript show:anInfoString.
micros < 1000 ifTrue:[
"/ too stupid: many fonts do not have a mu,
"/ so I output it as us here.
- Transcript show:micros; show:' s'.
+ Transcript show:micros; show:' µs'.
] ifFalse:[
micros < 100000 ifTrue:[
millis := (micros / 1000.0) asFixedPointRoundedToScale:2.
@@ -918,7 +975,7 @@
Transcript show:(TimeDuration milliseconds:millis).
].
].
- cycles ~~ 0 ifTrue:[
+ cycles notNil ifTrue:[
Transcript show:' ('; show:cycles; show:' cycles)'.
].
Transcript cr.
@@ -936,6 +993,8 @@
[10 factorial] benchmark:'11 factorial:'
[100 factorial] benchmark:'100 factorial:'
"
+
+ "Modified (comment): / 23-02-2017 / 21:06:29 / mawalch"
! !
!Block methodsFor:'error handling'!
@@ -1532,17 +1591,16 @@
i.e. change the priority for the execution of the receiver.
Bad name: should be called evaluateWithPriority: or similar"
- |oldPrio retVal activeProcess|
+ |oldPrio activeProcess|
activeProcess := Processor activeProcess.
oldPrio := Processor activePriority.
- [
+ ^ [
activeProcess priority:priority.
- retVal := self value.
+ self value.
] ensure:[
activeProcess priority:oldPrio
].
- ^ retVal
"
[
@@ -1552,7 +1610,8 @@
] valueAt:3
"
- "Created: / 29.7.1998 / 19:19:48 / cg"
+ "Created: / 29-07-1998 / 19:19:48 / cg"
+ "Modified: / 23-06-2017 / 11:13:30 / stefan"
!
valueWithArguments:argArrayIn
@@ -1940,13 +1999,191 @@
"
! !
+!Block methodsFor:'evaluation with timeout'!
+
+valueWithConfirmedTimeout:secondsOrTimeDuration confirmWith:confirmationBlock
+ "evaluate the receiver.
+ If not finished after secondsOrTimeDuration, call the confirmationBlock.
+ If it returns true, another time-interval is setup and we continue waiting.
+ If it returns a number (seconds) or a timeDuration, this time-interval is setup and we continue waiting.
+ If it returns false, nil is returned immediately.
+
+ The receiver's code must be prepared
+ for premature returning (by adding ensure blocks, as required)"
+
+ |ok retVal interrupter|
+
+ ok := false.
+ interrupter := [ ok ifFalse:[ TimeoutError raiseRequest ] ].
+ [
+ Processor addTimedBlock:interrupter after:secondsOrTimeDuration.
+
+ TimeoutError handle:[:ex |
+ |answer nextWaitTime|
+
+ answer := confirmationBlock valueWithOptionalArgument:ex.
+ answer == false ifTrue:[
+ ^ nil
+ ].
+ answer == true ifTrue:[
+ nextWaitTime := secondsOrTimeDuration
+ ] ifFalse:[
+ nextWaitTime := answer asTimeDuration
+ ].
+ "/ proceed, setting up another timeout
+ Processor addTimedBlock:interrupter after:nextWaitTime.
+ ex proceed
+ ] do:[
+ retVal := self value.
+ ok := true.
+ ].
+ ] ensure:[
+ Processor removeTimedBlock:interrupter.
+ ].
+ ^ retVal
+
+ "
+ [
+ 1 to:10 do:[:i |
+ Transcript showCR:i.
+ 1 seconds wait.
+ ].
+ 'finished'
+ ] valueWithConfirmedTimeout:(3 seconds) confirmWith:[
+ (Dialog confirm:'continue?')
+ ].
+ "
+
+ "
+ [
+ 1 to:10 do:[:i |
+ Transcript showCR:i.
+ 1 seconds wait.
+ ].
+ 'finished'
+ ] valueWithConfirmedTimeout:(3 seconds) confirmWith:[
+ (Dialog confirm:'wait another 5 seconds?') ifTrue:[
+ 5
+ ] ifFalse:[
+ false
+ ].
+ ].
+ "
+
+ "Created: / 26-06-2019 / 11:46:02 / Claus Gittinger"
+!
+
+valueWithTimeout:aTimeDurationOrIntegerSeconds
+ "execute the receiver, but abort the evaluation after aTimeDuration if still running.
+ Return the receiver's value, or nil if aborted.
+
+ The receiver's code must be prepared
+ for premature returning (by adding ensure blocks, as required)"
+
+ |milliseconds|
+
+ milliseconds := aTimeDurationOrIntegerSeconds isTimeDuration
+ ifTrue:[ aTimeDurationOrIntegerSeconds asMilliseconds ]
+ ifFalse:[ (aTimeDurationOrIntegerSeconds * 1000) truncated].
+ ^ self valueWithWatchDog:[nil] afterMilliseconds:milliseconds
+
+ "
+ [
+ 1 to:15 do:[:round |
+ Transcript showCR:round.
+ Delay waitForMilliseconds:20.
+ ].
+ true
+ ] valueWithTimeout:(TimeDuration seconds:1)
+ "
+
+ "
+ [
+ 1 to:100 do:[:round |
+ Transcript showCR:round.
+ Delay waitForMilliseconds:20.
+ ].
+ true
+ ] valueWithTimeout:(TimeDuration seconds:1)
+ "
+
+ "Modified (comment): / 26-06-2019 / 11:53:25 / Claus Gittinger"
+!
+
+valueWithWatchDog:exceptionBlock afterMilliseconds:aTimeLimit
+ "a watchdog on a block's execution. If the block does not finish its
+ evaluation after aTimeLimit milliseconds, it is interrupted (aborted) and
+ exceptionBlock's value is returned.
+
+ The receiver's code must be prepared
+ for premature returning (by adding ensure blocks, as required)"
+
+ |inError|
+
+ inError := false.
+
+ ^ TimeoutNotification handle:[:ex |
+ inError ifTrue:[
+ ex proceed
+ ].
+ exceptionBlock valueWithOptionalArgument:ex.
+ ] do:[
+ NoHandlerError handle:[:ex |
+ inError := true.
+ ex reject.
+ ] do:[
+ |showStopper me done|
+
+ done := false.
+ me := Processor activeProcess.
+ showStopper := [
+ done ifFalse:[
+ me interruptWith:[
+ (done not and:[me isDebugged not]) ifTrue:[
+ TimeoutNotification raiseRequest.
+ ]
+ ]
+ ]
+ ].
+
+ [
+ |retVal|
+
+ Processor
+ addTimedBlock:showStopper
+ for:me
+ afterMilliseconds:aTimeLimit.
+
+ retVal := self value.
+ done := true.
+ retVal
+ ] ensure:[
+ Processor removeTimedBlock:showStopper
+ ].
+ ]
+ ].
+
+ "
+ [
+ Delay waitForSeconds:5.
+ true
+ ] valueWithWatchDog:[false] afterMilliseconds:2000
+ "
+
+ "Modified: / 21-05-2010 / 12:19:57 / sr"
+ "Modified: / 19-03-2017 / 18:13:07 / cg"
+ "Modified: / 31-01-2018 / 08:34:51 / stefan"
+ "Modified: / 23-05-2018 / 12:47:00 / Maren"
+ "Modified (comment): / 26-06-2019 / 11:53:29 / Claus Gittinger"
+! !
+
!Block methodsFor:'exception handling'!
on:aSignalOrSignalSetOrException do:exceptionBlock
"added for ANSI compatibility; evaluate the receiver,
handling aSignalOrSignalSetOrException.
If the signal is raised during evaluation,
- the 2nd argument, exceptionBlock is evaluated (and its value returned"
+ the 2nd argument, exceptionBlock is evaluated (and its value returned)"
<context: #return>
<exception: #handle>
@@ -1972,7 +2209,8 @@
] on:Error do:[:ex| 2 ]
"
- "Modified: / 26.7.1999 / 15:30:48 / stefan"
+ "Modified: / 26-07-1999 / 15:30:48 / stefan"
+ "Modified (comment): / 26-06-2019 / 11:55:55 / Claus Gittinger"
!
on:aSignalOrSignalSetOrException do:exceptionBlock ensure:ensureBlock
@@ -2000,23 +2238,39 @@
e := 0.
[
1 foo
- ] on:MessageNotUnderstood
- do:[:ex | self halt]
- ensure:[ e := 1 ].
+ ] on:MessageNotUnderstood do:[:ex |
+ self halt
+ ] ensure:[
+ e := 1
+ ].
self assert:(e == 1).
"
"
+ [
+ 1 foo
+ ] on:MessageNotUnderstood do:[:ex |
+ ^ self
+ ] ensure:[
+ Transcript showCR:'ensure ensured'
+ ].
+ "
+
+ "
|e|
e := 0.
[
1 negated
- ] on:MessageNotUnderstood
- do:[:ex | self halt]
- ensure:[ e := 1 ].
+ ] on:MessageNotUnderstood do:[:ex |
+ self halt
+ ] ensure:[
+ e := 1
+ ].
self assert:(e == 1).
"
+
+ "Modified (comment): / 30-05-2018 / 21:20:14 / Claus Gittinger"
!
on:aSignalOrSignalSetOrException do:exceptionBlock ifCurtailed:curtailBlock
@@ -2076,6 +2330,20 @@
ifCurtailed:[ e := 1 ].
self assert:(e == 0).
"
+
+
+ "
+ |e|
+
+ e := 0.
+ [
+ 1 foo
+ ] on:MessageNotUnderstood do:[:ex | 2 bla]
+ ifCurtailed:[ e := 1 ].
+ self assert:(e == 0).
+ "
+
+ "Modified (comment): / 23-03-2017 / 19:10:31 / stefan"
!
on:anExceptionHandler do:exceptionBlock on:anExceptionHandler2 do:anExceptionBlock2
@@ -2117,96 +2385,6 @@
"Created: / 26.7.1999 / 11:23:45 / stefan"
"Modified: / 26.7.1999 / 11:24:06 / stefan"
-!
-
-valueWithTimeout:aTimeDurationOrIntegerSeconds
- "execute the receiver, but abort the evaluation after aTimeDuration if still running.
- Return the receiver's value, or nil if aborted."
-
- |milliseconds|
-
- milliseconds := aTimeDurationOrIntegerSeconds isTimeDuration
- ifTrue:[ aTimeDurationOrIntegerSeconds asMilliseconds ]
- ifFalse:[ (aTimeDurationOrIntegerSeconds * 1000) truncated].
- ^ self valueWithWatchDog:[^ nil] afterMilliseconds:milliseconds
-
- "
- [
- 1 to:15 do:[:round |
- Transcript showCR:round.
- Delay waitForMilliseconds:20.
- ].
- true
- ] valueWithTimeout:(TimeDuration seconds:1)
- "
-
- "
- [
- 1 to:100 do:[:round |
- Transcript showCR:round.
- Delay waitForMilliseconds:20.
- ].
- true
- ] valueWithTimeout:(TimeDuration seconds:1)
- "
-!
-
-valueWithWatchDog:exceptionBlock afterMilliseconds:aTimeLimit
- "a watchdog on a block's execution. If the block does not finish its
- evaluation after aTimeLimit milliseconds, it is interrupted (aborted) and
- exceptionBlock's value is returned. The receiver's code must be prepared
- for premature returning (by adding ensure blocks, as required)"
-
- |showStopper me retVal done inError|
-
- done := false.
- me := Processor activeProcess.
-
- showStopper :=
- [
- done ifFalse:[
- me interruptWith:[
- (Processor activeProcess state ~~ #debug) ifTrue:[
- done ifFalse:[ TimeoutNotification raiseRequest ]
- ]
- ]
- ]
- ].
-
- TimeoutNotification handle:[:ex |
- inError ifTrue:[
- ex proceed
- ].
- retVal := exceptionBlock value.
- ] do:[
- NoHandlerError handle:[:ex |
- inError := true.
- ex reject.
- ] do:[
- [
- Processor
- addTimedBlock:showStopper
- for:me
- afterMilliseconds:aTimeLimit.
-
- retVal := self value.
- done := true.
- ] ensure:[
- Processor removeTimedBlock:showStopper
- ].
- ]
- ].
- ^ retVal
-
- "
- [
- Delay waitForSeconds:5.
- true
- ] valueWithWatchDog:[false] afterMilliseconds:2000
- "
-
- "Modified: / 21-05-2010 / 12:19:57 / sr"
- "Modified: / 18-01-2011 / 19:24:13 / cg"
! !
!Block methodsFor:'exception handling private'!
@@ -2220,20 +2398,7 @@
exceptionCreator := anException creator.
exceptionHandlerInContext := aContext 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.
- ]
- ].
- aContext fullPrintString errorPrintCR.
- self breakPoint:#cg.
+ GenericException printBadExceptionHandler:exceptionHandlerInContext in:aContext.
^ nil.
].
(exceptionHandlerInContext accepts:exceptionCreator) ifTrue:[
@@ -2242,20 +2407,7 @@
exceptionHandlerInContext := aContext 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.
- ]
- ].
- aContext fullPrintString errorPrintCR.
- self breakPoint:#cg.
+ GenericException printBadExceptionHandler:exceptionHandlerInContext in:aContext.
^ nil.
].
(exceptionHandlerInContext accepts:exceptionCreator) ifTrue:[
@@ -2268,89 +2420,59 @@
^ aContext argAt:1.
!
-handlerForSignal:exceptionCreator context:theContext originator:originator
+handlerForSignal:exceptionCreator context:aContext originator:originator
"answer the handler block for the exceptionCreator from originator.
The handler block is retrieved from aContext.
Answer nil if the exceptionCreator is not handled."
|selector exceptionHandlerInContext|
- selector := theContext selector.
+ selector := aContext selector.
(selector == #on:do:
or:[ selector == #on:do:ensure:
or:[ selector == #on:do:ifCurtailed: ]]
) ifTrue:[
- exceptionHandlerInContext := theContext argAt:1.
+ exceptionHandlerInContext := aContext 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.
+ GenericException printBadExceptionHandler:exceptionHandlerInContext in:aContext.
^ 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"
+ aContext unmarkForUnwind. "if there is a handler, no unwind block has to be performed"
].
- ^ (theContext argAt:2) ? [nil].
+ ^ (aContext argAt:2) ? [nil].
].
^ nil
].
selector == #on:do:on:do: ifTrue:[
- exceptionHandlerInContext := theContext argAt:1.
+ exceptionHandlerInContext := aContext 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.
+ GenericException printBadExceptionHandler:exceptionHandlerInContext in:aContext.
^ nil.
].
(exceptionHandlerInContext == exceptionCreator
or:[exceptionHandlerInContext accepts:exceptionCreator]) ifTrue:[
- ^ (theContext argAt:2) ? [nil].
+ ^ (aContext argAt:2) ? [nil].
].
- exceptionHandlerInContext := theContext argAt:3.
+ exceptionHandlerInContext := aContext 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.
+ GenericException printBadExceptionHandler:exceptionHandlerInContext in:aContext.
^ nil.
].
(exceptionHandlerInContext == exceptionCreator
or:[exceptionHandlerInContext accepts:exceptionCreator]) ifTrue:[
- ^ (theContext argAt:4) ? [nil].
+ ^ (aContext argAt:4) ? [nil].
].
^ nil
].
selector == #valueWithExceptionHandler: ifTrue:[
- ^ (theContext argAt:1) handlerForSignal:exceptionCreator.
+ ^ (aContext argAt:1) handlerForSignal:exceptionCreator.
].
"/ mhmh - should not arrive here
@@ -2837,11 +2959,13 @@
sourcePos isString ifTrue:[ "/ misuses the sourcePosition slot
^ sourcePos
].
- m := self method.
+ m := self homeMethod.
m notNil ifTrue:[
^ m source
].
^ nil
+
+ "Modified: / 31-03-2017 / 17:26:52 / stefan"
!
source:aString
@@ -2887,7 +3011,10 @@
^ self value
].
+ "/ was not blocked
^ self ensure:[OperatingSystem unblockInterrupts].
+
+ "Modified (comment): / 24-07-2017 / 18:03:04 / cg"
!
valueUnpreemptively
@@ -2947,36 +3074,34 @@
passing the elements in argArray as arguments to the receiver block."
^ [self valueWithArguments:argArray] newProcess
-!
-
-promise
- "create a promise on the receiver. The promise will evaluate the
- receiver and promise to return the value with the #value message.
- The evaluation will be performed as a separate process.
- Asking the promise for its value will either block the asking process
- (if the evaluation has not yet been finished) or return the value
- immediately."
-
- ^ Promise value:self
+! !
+
+!Block methodsFor:'splitting & joining'!
+
+split: aSequenceableCollection indicesDo: aBlock
+ "let me split aSequenceableCollection and evaluate aBlock for each fragment's
+ start- and end-position"
+
+ | position |
+
+ position := 1.
+ aSequenceableCollection withIndexDo:[:element :idx |
+ (self value: element) ifTrue:[
+ aBlock value: position value: idx - 1.
+ position := idx + 1
+ ]
+ ].
+ aBlock value: position value: aSequenceableCollection size
"
- |p|
-
- p := [1000 factorial] promise.
- 'do something else ...'.
- p value
+ [ :char| char isSeparator ] split: 'aa bb cc dd'
+
+ [ :char| char isSeparator ] split: 'aa bb cc dd' do:[:fragment | Transcript showCR:fragment ]
+
+ [ :char| char isSeparator ] split: 'aa bb cc dd' indicesDo:[:start :end | Transcript show:start; show:' to '; showCR:end ]
"
-!
-
-promiseAt:prio
- "create a promise on the receiver. The promise will evaluate the
- receiver and promise to return the value with the #value message.
- The evaluation will be performed as a separate process running at prio.
- Asking the promise for its value will either block the asking process
- (if the evaluation has not yet been finished) or return the value
- immediately."
-
- ^ Promise value:self priority:prio
+
+ "Created: / 13-07-2017 / 18:32:09 / cg"
! !
!Block methodsFor:'testing'!
@@ -2987,6 +3112,14 @@
^ true
!
+isBlockWithArgumentCount:count
+ "return true, if this is a block with count args"
+
+ ^ nargs == count
+
+ "Created: / 18-03-2017 / 18:07:03 / stefan"
+!
+
isCheapBlock
^ false
!
--- a/GenericException.st Sat Jan 25 21:55:08 2020 +0000
+++ b/GenericException.st Wed May 20 18:34:29 2020 +0100
@@ -1,6 +1,8 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -33,7 +35,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -214,20 +216,6 @@
"Created: / 20-11-2006 / 14:00:09 / cg"
!
-signal:messageText
- "raise a signal proceedable or nonproceedable (whichever is right).
- The argument is used as messageText."
-
- <context: #return>
-
- ^ (self newException
- suspendedContext:thisContext sender
- errorString:messageText)
- raiseSignal.
-
- "Modified: / 10-08-2010 / 09:41:56 / cg"
-!
-
signalWith:messageText
"raise a signal proceedable or nonproceedable (whichever is right).
The argument is used as messageText.
@@ -239,6 +227,7 @@
! !
+
!GenericException class methodsFor:'accessing'!
errorString
@@ -333,17 +322,17 @@
|sig|
self isQuerySignal ifTrue:[
- sig := QuerySignal basicNew.
- mayProceedBoolean ifFalse:[
- 'Exception [warning]: nonProceedable queries do not make sense' infoPrintCR.
- ].
+ sig := QuerySignal basicNew.
+ mayProceedBoolean ifFalse:[
+ 'Exception [warning]: nonProceedable queries do not make sense' infoPrintCR.
+ ].
] ifFalse:[
- sig := Signal basicNew.
+ sig := Signal basicNew.
].
^ sig
- mayProceed:mayProceedBoolean;
- notifierString:NotifierString;
- parent:self
+ mayProceed:mayProceedBoolean;
+ notifierString:NotifierString;
+ parent:self
"Created: / 23.7.1999 / 20:12:43 / stefan"
! !
@@ -353,7 +342,13 @@
, anExceptionHandler
"return a SignalSet with myself and anExceptionHandler"
+ anExceptionHandler isNil ifTrue:[
+ "Ignore nil exceptionHandler - it may be due to a missing (not loaded) expception class"
+ ^ self.
+ ].
^ SignalSet with:self with:anExceptionHandler
+
+ "Modified (format): / 09-12-2019 / 11:09:28 / Stefan Vogel"
! !
@@ -368,12 +363,12 @@
|parent|
NotifierString isNil ifTrue:[
- ^ self nameForDescription asString
+ ^ self nameForDescription asString
].
(NotifierString startsWith:Character space) ifTrue:[
- (parent := self parent) notNil ifTrue:[
- ^ parent description, NotifierString
- ].
+ (parent := self parent) notNil ifTrue:[
+ ^ parent description, NotifierString
+ ].
].
^ NotifierString
@@ -392,34 +387,67 @@
^ self name
"Created: / 10-02-2011 / 12:28:51 / cg"
+!
+
+printBadExceptionHandler:badExceptionHandler in:aContext
+ "if anyone does:
+ [ xxx ] on: foo do:[ ... ]
+ with a bad foo (i.e. nil or not an Exception, ExceptionSet, Signal or HandlerSet
+ this method is called to print a warning.
+ Usually, this happens when foo is misspelled or when porting code
+ from Squeak, and there is no such exception-class in ST/X.
+ A typical situation is:
+ [ xxx ] on: NetworkError do:[ ... ]
+ "
+
+ badExceptionHandler isNil ifTrue:[
+ 'Block [warning]: nil Exception in on:do:on:do:-context' errorPrintCR.
+ 'Block [warning]: the sender is: ' infoPrint. aContext sender errorPrintCR.
+ ] ifFalse:[
+ (badExceptionHandler isBehavior
+ and:[badExceptionHandler isLoaded not]) ifTrue:[
+ "If the exception class is still autoloaded,
+ it does not accept our exception. Raising the exception would load the class"
+ ^ nil
+ ].
+ 'Block [warning]: non-Exception in on:do:on:do:-context' errorPrintCR.
+ 'Block [warning]: the context is: ' infoPrint. aContext sender errorPrintCR.
+ ].
+ aContext fullPrintString errorPrintCR.
+ self breakPoint:#cg.
+ ^ nil.
! !
!GenericException class methodsFor:'queries'!
-accepts:aSignal
- "return true, if the receiver accepts the argument, aSignal.
+accepts:aSignalOrExceptionClass
+ "return true, if the receiver accepts the argument, aSignalOrExceptionClass.
(i.e. the receiver is aSignal or a parent of it). False otherwise."
|s|
- self == aSignal ifTrue:[^ true].
- aSignal isQuerySignal ifTrue:[^ false].
-
- s := aSignal parent.
- [s notNil] whileTrue:[
- self == s ifTrue:[^ true].
- s := s parent
+ self == aSignalOrExceptionClass ifTrue:[^ true].
+ "/ the following line depends on this method being redefined in the Notification subclass
+ aSignalOrExceptionClass isQuerySignal ifTrue:[^ false].
+
+ s := aSignalOrExceptionClass.
+ [(s := s parent) notNil] whileTrue:[
+ self == s ifTrue:[^ true].
].
^ false
- "Created: / 23.7.1999 / 14:00:47 / stefan"
+ "Created: / 23-07-1999 / 14:00:47 / stefan"
+ "Modified (comment): / 28-08-2018 / 11:14:59 / Claus Gittinger"
!
-exception:anException isHandledIn:aContext
- "return true, if there is a handler for anException in the
+exception:anExceptionClass isHandledIn:aContext
+ "utility:
+ return true, if there is a handler for anException in the
contextChain starting with aContext."
- ^ (self handlerContextForException:anException in:aContext) notNil
+ ^ (self handlerContextForException:anExceptionClass in:aContext) notNil
+
+ "Modified (comment): / 06-09-2019 / 15:54:45 / Stefan Reise"
!
exceptionHandlerFor:anException in:aContext
@@ -430,14 +458,15 @@
sel := aContext selector.
(sel == #'handle:from:do:'
or:[sel == #'handle:do:']) ifTrue:[
- ^ aContext receiver
+ ^ aContext receiver
].
^ nil
!
-handlerContextForException:anException in:aContext
- "return a handlerContext for anException in the
+handlerContextForException:anExceptionClass in:aContext
+ "utility:
+ return a handlerContext for anException in the
contextChain starting with aContext.
Returns nil, if there is no handler."
@@ -445,46 +474,49 @@
theContext := aContext findExceptional.
[theContext notNil] whileTrue:[
- theContext isRaiseContext ifTrue:[
- "skip all the contexts between the raise and the sender of #handle:do"
- ex1 := theContext receiver. "exception, that has been raised"
- con1 := ex1 handlerContext. "the context of the #handle:do:"
- con1 notNil ifTrue:[
- "handlerContext may be nil, if this is a default action"
- theContext := con1.
- ].
- ex1 := con1 := nil.
- ] ifFalse:[ |r|
- ((r := theContext receiver) notNil
- and:[(r handlerForSignal:anException context:theContext originator:nil) notNil]
- ) ifTrue:[
- "found a handler context"
- ^ theContext
- ].
- ].
- theContext notNil ifTrue:[
- theContext := theContext findSpecialHandle:true raise:true.
- ].
+ theContext isRaiseContext ifTrue:[
+ "skip all the contexts between the raise and the sender of #handle:do"
+ ex1 := theContext receiver. "exception, that has been raised"
+ con1 := ex1 handlerContext. "the context of the #handle:do:"
+ con1 notNil ifTrue:[
+ "handlerContext may be nil, if this is a default action"
+ theContext := con1.
+ ].
+ ex1 := con1 := nil.
+ ] ifFalse:[ |r|
+ ((r := theContext receiver) notNil
+ and:[(r handlerForSignal:anExceptionClass context:theContext originator:nil) notNil]
+ ) ifTrue:[
+ "found a handler context"
+ ^ theContext
+ ].
+ ].
+ theContext notNil ifTrue:[
+ theContext := theContext findSpecialHandle:true raise:true.
+ ].
].
^ nil
+
+ "Modified (comment): / 06-09-2019 / 15:52:49 / Stefan Reise"
!
-handlerForSignal:signal context:theContext originator:originator
+handlerForSignal:exceptionCreator context:theContext originator:originator
"answer the handler block for the signal from originator.
The block is retrieved from aContext.
Answer nil if the signal is not handled"
(theContext selector ~~ #'handle:from:do:'
or:[(theContext argAt:2) == originator]) ifTrue:[
- (self == signal or:[self accepts:signal]) ifTrue:[
- ^ (theContext argAt:1) ? [nil]
- ]
+ (self == exceptionCreator or:[self accepts:exceptionCreator]) ifTrue:[
+ ^ (theContext argAt:1) ? [nil]
+ ]
].
^ nil
- "Created: / 25.7.1999 / 19:52:58 / stefan"
+ "Created: / 25-07-1999 / 19:52:58 / stefan"
+ "Modified (format): / 06-09-2019 / 15:48:12 / Stefan Reise"
!
handlerProtectedBlock:doBlock inContext:context
@@ -494,9 +526,9 @@
sel := context selector.
sel == #handle:do: ifTrue:[
- context argAt:2 put:doBlock.
+ context argAt:2 put:doBlock.
] ifFalse:[sel == #handle:from:do: ifTrue:[
- context argAt:3 put:doBlock.
+ context argAt:3 put:doBlock.
]].
!
@@ -504,27 +536,40 @@
"return true, if the receiver handles the argument, anException.
(i.e. the receiver is anExceptions signal or a parent of it)"
- |signal|
-
- signal := anException creator.
-
- self == signal ifTrue:[^ true]. "quick check"
- anException isNotification ifTrue:[^ false]. "speed up queries by not traversing the parent chain"
-
- [(signal := signal parent) notNil] whileTrue:[
- self == signal ifTrue:[^ true].
- ].
- ^ false
+ ^ self accepts:(anException creator).
+
+"/ |signal|
+"/
+"/ signal := anException creator.
+"/
+"/ self == signal ifTrue:[^ true]. "quick check"
+"/ anException isNotification ifTrue:[^ false]. "speed up queries by not traversing the parent chain"
+"/
+"/ [(signal := signal parent) notNil] whileTrue:[
+"/ self == signal ifTrue:[^ true].
+"/ ].
+"/ ^ false
+
+ "Modified: / 28-08-2018 / 11:30:49 / Claus Gittinger"
+!
+
+isAcceptedBy:aHandlerSignal
+ "return true, if aHandlerSignal accepts the receiver."
+
+ ^ aHandlerSignal accepts:self
+
+ "Created: / 28-08-2018 / 10:56:58 / Claus Gittinger"
!
isHandled
- "return true, if there is a handler for the receiver signal.
+ "return true, if there is a handler for the receiver signal/exception class.
Raising an unhandled signal will usually lead into the debugger,
but can be caught globally by setting Exceptions EmergencyHandler."
^ self exception:self isHandledIn:(thisContext sender).
- "Created: / 23.7.1999 / 14:03:50 / stefan"
+ "Created: / 23-07-1999 / 14:03:50 / stefan"
+ "Modified (comment): / 06-09-2019 / 15:54:31 / Stefan Reise"
!
isHandledIn:aContext
@@ -540,13 +585,13 @@
existing Signals."
self == GenericException ifTrue:[
- ^ nil
+ ^ nil
].
-
^ self superclass
- "Created: / 23.7.1999 / 14:01:29 / stefan"
- "Modified: / 23.7.1999 / 16:15:38 / stefan"
+ "Created: / 23-07-1999 / 14:01:29 / stefan"
+ "Modified: / 23-07-1999 / 16:15:38 / stefan"
+ "Modified: / 28-08-2018 / 11:13:28 / Claus Gittinger"
! !
!GenericException class methodsFor:'raising'!
@@ -559,7 +604,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseIn:thisContext sender
+ raiseIn:thisContext sender
"Created: / 23-07-1999 / 14:07:17 / stefan"
"Modified: / 10-08-2010 / 09:30:42 / cg"
@@ -617,8 +662,8 @@
^ self defaultAnswer
"Modified: / 15-06-1998 / 21:27:37 / cg"
- "Modified: / 25-07-1999 / 23:15:16 / stefan"
"Modified: / 11-03-2015 / 11:26:45 / sr"
+ "Modified: / 25-07-2017 / 16:45:41 / stefan"
!
raiseErrorString:aString
@@ -629,8 +674,8 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseErrorString:aString
- in:thisContext sender
+ raiseErrorString:aString
+ in:thisContext sender
"Created: / 23-07-1999 / 14:07:33 / stefan"
"Modified: / 10-08-2010 / 09:34:37 / cg"
@@ -644,7 +689,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseErrorString:aString in:aContext
+ raiseErrorString:aString in:aContext
"Created: / 23-07-1999 / 14:07:33 / stefan"
"Modified: / 10-08-2010 / 09:35:37 / cg"
@@ -658,8 +703,8 @@
<resource: #skipInDebuggersWalkBack>
^ (self newException
- suspendedContext:thisContext sender parameter:something originator:something)
- raise
+ suspendedContext:thisContext sender parameter:something originator:something)
+ raise
"Modified: / 2.5.1996 / 16:36:38 / cg"
"Modified: / 5.3.1998 / 16:49:55 / stefan"
@@ -674,7 +719,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseIn:aContext
+ raiseIn:aContext
"Created: / 27-01-2011 / 17:28:53 / cg"
!
@@ -687,7 +732,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseRequestIn:thisContext sender
+ raiseRequestIn:thisContext sender
"Created: / 23-07-1999 / 14:08:24 / stefan"
"Modified: / 10-08-2010 / 09:37:06 / cg"
@@ -701,7 +746,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseRequestErrorString:aString in:thisContext sender
+ raiseRequestErrorString:aString in:thisContext sender
"Modified: / 10-08-2010 / 09:40:38 / cg"
!
@@ -714,8 +759,8 @@
<resource: #skipInDebuggersWalkBack>
^ (self newException
- suspendedContext:thisContext sender parameter:something originator:something)
- raiseRequest
+ suspendedContext:thisContext sender parameter:something originator:something)
+ raiseRequest
"Modified: / 2.5.1996 / 16:36:38 / cg"
"Modified: / 5.3.1998 / 16:52:46 / stefan"
@@ -730,7 +775,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseRequestIn:aContext
+ raiseRequestIn:aContext
"Created: / 27-01-2011 / 17:28:53 / cg"
!
@@ -743,7 +788,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseRequestWith:aParameter in:thisContext sender
+ raiseRequestWith:aParameter in:thisContext sender
"Created: / 23-07-1999 / 14:08:48 / stefan"
"Modified: / 10-08-2010 / 09:57:14 / cg"
@@ -757,10 +802,13 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseRequestWith:aParameter errorString:aString in:thisContext sender
+ raiseRequestWith:aParameter
+ errorString:aString
+ in:thisContext sender
"Created: / 23-07-1999 / 14:08:57 / stefan"
"Modified: / 10-08-2010 / 09:56:55 / cg"
+ "Modified (format): / 17-11-2017 / 18:36:18 / cg"
!
raiseRequestWith:aParameter errorString:aString in:aContext
@@ -773,7 +821,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseRequestWith:aParameter errorString:aString in:aContext
+ raiseRequestWith:aParameter errorString:aString in:aContext
"Created: / 23-07-1999 / 14:09:07 / stefan"
"Modified: / 10-08-2010 / 09:56:36 / cg"
@@ -788,7 +836,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseRequestWith:aParameter in:aContext
+ raiseRequestWith:aParameter in:aContext
"Modified: / 10-08-2010 / 09:56:12 / cg"
!
@@ -801,8 +849,8 @@
<resource: #skipInDebuggersWalkBack>
^ (self newException
- suspendedContext:thisContext sender)
- raiseSignal
+ suspendedContext:thisContext sender)
+ raiseSignal
"Modified: / 10.11.2001 / 15:13:34 / cg"
!
@@ -815,8 +863,8 @@
<resource: #skipInDebuggersWalkBack>
^ (self newException
- suspendedContext:thisContext sender errorString:errorMessage)
- raiseSignal.
+ suspendedContext:thisContext sender errorString:errorMessage)
+ raiseSignal.
"Modified: / 07-08-2004 / 19:24:00 / stefan"
!
@@ -829,8 +877,8 @@
<resource: #skipInDebuggersWalkBack>
^ (self newException
- suspendedContext:thisContext sender parameter:aParameter errorString:errorMessage)
- raiseSignal.
+ suspendedContext:thisContext sender parameter:aParameter errorString:errorMessage)
+ raiseSignal.
"Modified: / 07-08-2004 / 19:10:40 / stefan"
!
@@ -843,8 +891,8 @@
<resource: #skipInDebuggersWalkBack>
^ (self newException
- suspendedContext:thisContext sender errorString:aString)
- raiseSignal.
+ suspendedContext:thisContext sender errorString:aString)
+ raiseSignal.
!
raiseSignalWith:aParameter
@@ -855,8 +903,8 @@
<resource: #skipInDebuggersWalkBack>
^ (self newException
- suspendedContext:thisContext sender parameter:aParameter)
- raiseSignal.
+ suspendedContext:thisContext sender parameter:aParameter)
+ raiseSignal.
!
raiseSignalWith:aParameter errorString:aString
@@ -868,8 +916,8 @@
<resource: #skipInDebuggersWalkBack>
^ (self newException
- suspendedContext:thisContext sender parameter:aParameter errorString:aString)
- raiseSignal.
+ suspendedContext:thisContext sender parameter:aParameter errorString:aString)
+ raiseSignal.
!
raiseWith:aParameter
@@ -880,7 +928,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseWith:aParameter in:thisContext sender
+ raiseWith:aParameter in:thisContext sender
"Created: / 23-07-1999 / 14:09:27 / stefan"
"Modified: / 10-08-2010 / 09:51:11 / cg"
@@ -895,7 +943,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseWith:aParameter errorString:aString in:thisContext sender.
+ raiseWith:aParameter errorString:aString in:thisContext sender.
"Created: / 23-07-1999 / 14:09:36 / stefan"
"Modified: / 10-08-2010 / 09:52:59 / cg"
@@ -912,7 +960,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseWith:aParameter errorString:aString in:aContext.
+ raiseWith:aParameter errorString:aString in:aContext.
"Created: / 23-07-1999 / 14:09:46 / stefan"
"Modified: / 10-08-2010 / 09:52:10 / cg"
@@ -928,7 +976,7 @@
<resource: #skipInDebuggersWalkBack>
^ self basicNew
- raiseWith:aParameter in:aContext
+ raiseWith:aParameter in:aContext
"Modified: / 10-08-2010 / 09:52:38 / cg"
! !
@@ -963,8 +1011,8 @@
Ignore the receiver-exception during evaluation - i.e. simply continue,
but remember if the signal was raised.
After the block evaluation, finally raise the signal - if it was raised in the block.
- If the signal is raised multiple times, only the first raises parameter is remembered,
- and only a single raise is performed after the blocks evaluation.
+ If the signal is raised multiple times, only the first raise's parameter is remembered,
+ and only a single raise is performed after the block's evaluation.
Deferring makes sense for some signals, such as UserInterrupt or AbortSignal,
which must occasionally be delayed temporarily until a save place is reached
@@ -1000,6 +1048,7 @@
"
"Modified: / 07-12-2006 / 17:05:28 / cg"
+ "Modified (comment): / 24-07-2018 / 22:54:35 / Claus Gittinger"
!
evaluate:aBlock ifRaised:exceptionValue
@@ -1008,13 +1057,15 @@
the evaluation and return the value from exceptionValue.
This is similar to the catch & throw mechanism found in other languages"
- ^ self handle:[:ex | exceptionValue value] do:aBlock.
+ ^ self handle:exceptionValue do:aBlock.
"
- Object messageNotUnderstoodSignal
- evaluate:[ 123 size open ]
- ifRaised:345
+ MessageNotUnderstood
+ evaluate:[ 123 size open ]
+ ifRaised:345
"
+
+ "Modified (comment): / 12-01-2018 / 17:48:24 / stefan"
!
handle:handleBlock do:aBlock
@@ -1034,10 +1085,10 @@
"
Object messageNotUnderstoodSignal handle:[:ex |
- 'oops' printNL.
- ex return
+ 'oops' printNL.
+ ex return
] do:[
- 123 size open
+ 123 size open
]
"
@@ -1046,10 +1097,10 @@
num := 0.
Number divisionByZeroSignal handle:[:ex |
- 'oops' printNL.
- ex return
+ 'oops' printNL.
+ ex return
] do:[
- 123 / num
+ 123 / num
]
"
@@ -1082,17 +1133,17 @@
o1 := 123.
o2 := nil.
Object messageNotUnderstoodSignal
- handle:
- [:ex |
- 'oops' printNL.
- ex proceed
- ]
- from:o1
- do:
- [
- o1 open.
- o2 open
- ]
+ handle:
+ [:ex |
+ 'oops' printNL.
+ ex proceed
+ ]
+ from:o1
+ do:
+ [
+ o1 open.
+ o2 open
+ ]
"
"Created: / 23-07-1999 / 14:06:26 / stefan"
@@ -1102,21 +1153,24 @@
ignoreIn:aBlock
"evaluate the argument, aBlock.
- Ignore the receiver-exception during evaluation - i.e. simply continue.
+ Ignore the receiver-exception during evaluation - i.e. simply continue with the default resume value.
This makes only sense for some signals, such as UserInterrupt
- or AbortSignal, because continuing after an exception without any cleanup
+ or AbortOperationRequest, because continuing after an exception without any cleanup
often leads to followup-errors."
- ^ self handle:[:ex | ex proceedWith:nil] do:aBlock.
+ ^ self handle:[:ex | ex proceed] do:aBlock.
"
Object messageNotUnderstoodSignal ignoreIn:[
- 123 size open
+ 123 size open
]
+
+ DomainError ignoreIn:[ -1.0 log10 ]
"
"Created: / 23-07-1999 / 14:06:40 / stefan"
- "Modified: / 07-12-2006 / 17:05:35 / cg"
+ "Modified (comment): / 24-02-2017 / 11:15:44 / stefan"
+ "Modified (comment): / 20-06-2017 / 13:35:03 / cg"
! !
!GenericException class methodsFor:'testing'!
@@ -1156,6 +1210,14 @@
^ false
!
+isQuery
+ "return true, if this is a query - always return false here"
+
+ ^ false
+
+ "Created: / 21-07-2017 / 00:53:29 / cg"
+!
+
isQuerySignal
"return true, if this is a querySignal - always return false here"
@@ -1218,19 +1280,19 @@
con := suspendedContext.
^ ((1 to:numberOfFrames)
- collect:[:idx |
- |s|
-
- s := con printString.
- con := con sender.
- s
- ]) asStringWith:Character cr.
+ collect:[:idx |
+ |s|
+
+ s := con printString.
+ con := con sender.
+ s
+ ]) asStringWith:Character cr.
"
Error handle:[:ex |
- (ex stackTrace:20) inspect.
+ (ex stackTrace:20) inspect.
] do:[
- self error
+ self error
].
"
! !
@@ -1293,9 +1355,9 @@
errorString
"return the errorString passsed with the signal raise
(or nil, if there was none).
- #errorString is deprecated, use description instead"
-
- <resource:#obsolete>
+ #errorString is the same as description,
+ which returns the messageText plain or appended or prepended to the
+ classes description string."
^ self description
@@ -1304,11 +1366,13 @@
errorString:aString
"set the messageText.
- If it starts with a space, the signals messageText is prepended,
+ If it starts with a space, the signal's messageText is prepended,
if it ends with a space, it is appended.
- #errorString: is deprecated, use messageText: instead"
-
- <resource:#obsolete>
+
+ #errorString: does the same as messageText:,
+ but should be used for errors and exceptions,
+ whereas messageText: should be used for notifications and queries
+ (for documentation only)"
messageText := aString
@@ -1323,23 +1387,23 @@
the object which accepted the actual exception."
handlerContext isNil ifTrue:[
- ^ nil.
+ ^ nil.
].
^ handlerContext receiver exceptionHandlerFor:self in:handlerContext.
"
[
- 2 // 0
+ 2 // 0
] on:Error do:[:ex| ex handler inspect]
[
- 2 // 0
+ 2 // 0
] on:ArithmeticError, Error do:[:ex| ex handler inspect]
[
- 2 // 0
+ 2 // 0
] on:MessageNotUnderstood do:[:ex| ex handler inspect]
- on:Error do:[:ex| ex handler inspect]
+ on:Error do:[:ex| ex handler inspect]
"
!
@@ -1375,7 +1439,12 @@
messageText:aString
"set the messageText.
If it starts with a space, the signal's original messageText is prepended,
- if it ends with a space, it is appended."
+ if it ends with a space, it is appended.
+
+ messageText: does the same as errorString:,
+ but should be used for notifications and queries,
+ whereas errorString: should be used for errors and exceptions
+ (for documentation only)"
messageText := aString
@@ -1421,6 +1490,15 @@
"Created: / 5.3.1998 / 16:34:22 / stefan"
!
+parameter:anObject errorString:errorString
+ "set the parameter of the exception"
+
+ parameter := anObject.
+ messageText := errorString.
+
+ "Created: / 5.3.1998 / 16:34:22 / stefan"
+!
+
proceedable:aBoolean
"explicitly change the proceedability.
Normally this gets initialized from the classes idea of whether this makes sense"
@@ -1479,6 +1557,26 @@
suspendedContext := raisingContext
!
+setHandlerContext:aContextOrNil
+ "set the value of the instance variable 'suspendedContext' (automatically generated)"
+
+ handlerContext := aContextOrNil.
+!
+
+setRaiseContext:aContextOrNil
+ "set the value of the instance variable 'suspendedContext' (automatically generated)"
+
+ raiseContext := aContextOrNil.
+!
+
+setSuspendedContext:aContextOrNil
+ "set the value of the instance variable 'suspendedContext' (automatically generated)"
+
+ suspendedContext := aContextOrNil.
+
+
+!
+
suspendedContext
"return the context in which the raise occurred"
@@ -1501,7 +1599,37 @@
"Modified: / 2.3.1998 / 12:20:43 / stefan"
! !
-!GenericException methodsFor:'copying'!
+!GenericException methodsFor:'copying-private'!
+
+copyWithWalkbackUpTo:aContextOrNil
+ "generate a (dead) copy of myself with a dead copy of my calling chain.
+ This is no longer alive, so it cannot be resumed or restarted.
+ Only useful to copy a walkback inside a handler for later
+ presentation
+ (eg. when copying for reraise in another thread, eg in a promise)"
+
+ |mapping copy sndr prevCopy copyOfSndr|
+
+ mapping := IdentityDictionary new.
+
+ sndr := suspendedContext.
+ [sndr notNil and:[sndr ~~ aContextOrNil]] whileTrue:[
+ copyOfSndr := sndr shallowCopy.
+ mapping at:sndr put:copyOfSndr.
+ copyOfSndr setSender:nil.
+ prevCopy notNil ifTrue:[
+ prevCopy setSender:copyOfSndr.
+ ].
+ prevCopy := copyOfSndr.
+ sndr := sndr sender.
+ ].
+
+ copy := self shallowCopy.
+ copy setSuspendedContext:(mapping at:suspendedContext ifAbsent:nil).
+ copy setHandlerContext:nil.
+ copy setRaiseContext:(mapping at:raiseContext ifAbsent:nil).
+ ^ copy
+!
postCopy
"set the internal state to nil"
@@ -1538,8 +1666,8 @@
try per signal handler
"
(handlerBlock := self creator handlerBlock) notNil ifTrue:[
- "... and call it"
- ^ handlerBlock value:self.
+ "... and call it"
+ ^ handlerBlock value:self.
].
^ self noHandler.
@@ -1571,21 +1699,21 @@
|msg|
rejected == true ifTrue:[
- msg := 'unhandled (rejected)'
+ msg := 'unhandled (rejected)'
] ifFalse:[
- msg := 'unhandled'
+ msg := 'unhandled'
].
msg := msg , ' exception: (' , self description , ')'.
self mayProceed ifTrue:[
- ^ NoHandlerError
- raiseRequestWith:self
- errorString:msg
- in:suspendedContext.
+ ^ NoHandlerError
+ raiseRequestWith:self
+ errorString:msg
+ in:suspendedContext.
].
^ NoHandlerError
- raiseWith:self
- errorString:msg
- in:suspendedContext.
+ raiseWith:self
+ errorString:msg
+ in:suspendedContext.
! !
!GenericException methodsFor:'default values'!
@@ -1607,9 +1735,9 @@
VW compatibility."
self isResumable ifTrue:[
- self proceedWith:(self defaultResumeValue)
+ self proceedWith:(self defaultResumeValue)
] ifFalse:[
- self return:(self defaultReturnValue)
+ self return:(self defaultReturnValue)
]
"Modified: / 7.9.2001 / 13:28:54 / cg"
@@ -1620,9 +1748,9 @@
VW compatibility."
self isResumable ifTrue:[
- self proceedWith:value
+ self proceedWith:value
] ifFalse:[
- self return:value
+ self return:value
]
"Created: / 7.9.2001 / 13:29:55 / cg"
@@ -1635,13 +1763,13 @@
self proceedWith:(self defaultResumeValue).
"cg: a strange example:
- there are two caught errors here - can you spot them ?
+ there are two caught errors here - can you spot them ?
Error handle:[:ex|
- 'proceeding' printCR.
- ex proceed
+ 'proceeding' printCR.
+ ex proceed
] do:[
- Error raiseRequest
+ Error raiseRequest
].
"
@@ -1655,9 +1783,9 @@
|con rCon|
(StrictRaising and:[proceedable not]) ifTrue:[
- "proceed from ProceedError to recover from this error"
- ProceedError raiseRequestWith:self.
- proceedable := true.
+ "proceed from ProceedError to recover from this error"
+ ProceedError raiseRequestWith:self.
+ proceedable := true.
].
thisContext evaluateUnwindActionsUpTo:suspendedContext.
@@ -1670,7 +1798,7 @@
"we arrive here, if suspendedContext is not resumable -
resume our raise context ...
... consider this a fallBack kludge, for the case that
- a raising context is not returnable."
+ a raising context is not returnable."
rCon return:value.
@@ -1688,7 +1816,7 @@
con := Context findFirstSpecialHandle:false raise:true.
[con notNil
and:[con receiver ~~ self]] whileTrue:[
- con := con findSpecialHandle:false raise:true.
+ con := con findSpecialHandle:false raise:true.
].
"returning form the doCallXX: signals a reject"
@@ -1697,15 +1825,15 @@
"
Error handle:[:ex |
- '1' printCR.
- ex reject
+ '1' printCR.
+ ex reject
] do:[
- Error handle:[:ex |
- '2' printCR.
- ex reject
- ] do:[
- #() at:1
- ]
+ Error handle:[:ex |
+ '2' printCR.
+ ex reject
+ ] do:[
+ #() at:1
+ ]
]
"
!
@@ -1724,9 +1852,9 @@
|rslt|
ZeroDivide handle:[:ex |
- ex resignalAs:DomainError
+ ex resignalAs:DomainError
] do:[
- rslt := 5 // 0
+ rslt := 5 // 0
].
rslt
"
@@ -1735,9 +1863,9 @@
|rslt|
MessageNotUnderstood handle:[:ex |
- ex resignalAs:Number domainErrorSignal
+ ex resignalAs:Number domainErrorSignal
] do:[
- rslt := 1 perform:#foo
+ rslt := 1 perform:#foo
].
rslt
"
@@ -1747,14 +1875,14 @@
firstTime := true.
ZeroDivide handle:[:ex |
- firstTime ifTrue:[
- Dialog information:'again...'.
- firstTime := false.
- ex resignalAs:ZeroDivide.
- ].
- Dialog information:'arrived here again...'.
+ firstTime ifTrue:[
+ Dialog information:'again...'.
+ firstTime := false.
+ ex resignalAs:ZeroDivide.
+ ].
+ Dialog information:'arrived here again...'.
] do:[
- rslt := 5 // 0
+ rslt := 5 // 0
].
rslt
"
@@ -1778,11 +1906,11 @@
|rslt n|
Error handle:[:ex |
- Transcript showCR:'fixing divisor ...'.
- n := 1.
- ex restart.
+ Transcript showCR:'fixing divisor ...'.
+ n := 1.
+ ex restart.
] do:[
- rslt := 5 / n.
+ rslt := 5 / n.
].
rslt
"
@@ -1815,11 +1943,11 @@
sig := Signal new.
sig handle:[:ex |
- Transcript showCR:'exchanging do-block ...'.
- ex restartDo:[ rslt := 999 ]
+ Transcript showCR:'exchanging do-block ...'.
+ ex restartDo:[ rslt := 999 ]
] do:[
- rslt := 0.
- sig raise
+ rslt := 0.
+ sig raise
].
Transcript showCR:rslt
"
@@ -1828,9 +1956,9 @@
|sig rslt|
Object errorSignal handle:[:ex |
- ex restartDo:[ rslt := 999 ]
+ ex restartDo:[ rslt := 999 ]
] do:[
- rslt := nil foo.
+ rslt := nil foo.
].
Transcript showCR:rslt
@@ -1840,9 +1968,9 @@
|sig rslt|
Object errorSignal handle:[:ex |
- ex restartDo:[ 'handler' printCR. rslt := nil foo ]
+ ex restartDo:[ 'handler' printCR. rslt := nil foo ]
] do:[
- rslt := nil foo.
+ rslt := nil foo.
].
Transcript showCR:rslt
@@ -1947,11 +2075,11 @@
con returnDoing:aBlock
"
- [
- 5 // 0
- ] on:Error do:[:ex|
- ex returnDoing:[self halt. 47*11].
- ]
+ [
+ 5 // 0
+ ] on:Error do:[:ex|
+ ex returnDoing:[self halt. 47*11].
+ ]
"
!
@@ -1964,20 +2092,22 @@
!GenericException methodsFor:'printing & storing'!
description
- "return the description string of the signal"
+ "return the description string of the signal/exception.
+ If a messageText has been set, that is returned plain, appended or prepended to the
+ classes description string."
|sigDescr|
sigDescr := self creator description.
(messageText isNil or:[messageText isString not])
ifTrue:[
- ^ sigDescr
+ ^ sigDescr
].
(messageText startsWith:Character space) ifTrue:[
- ^ sigDescr, messageText.
+ ^ sigDescr, messageText.
].
(messageText endsWith:Character space) ifTrue:[
- ^ messageText, sigDescr.
+ ^ messageText, sigDescr.
].
^ messageText
@@ -2008,16 +2138,17 @@
"helper for all raiseRequest methods"
self mayProceed ifFalse:[
- StrictRaising ifTrue:[
- "/ proceeding from wrongProceedabilitySignal grants the raiseRequest
- WrongProceedabilityError raiseRequestWith:self creator.
- ] ifFalse:[
- self class name infoPrint.
- ' [warning]: raised with wrong proceedability' infoPrintCR.
- ]
+ StrictRaising ifTrue:[
+ "/ proceeding from wrongProceedabilitySignal grants the raiseRequest
+ WrongProceedabilityError raiseRequestWith:self creator.
+ ] ifFalse:[
+ self className infoPrint.
+ ' [warning]: raised with wrong proceedability' infoPrintCR.
+ ]
].
"Created: / 10-08-2010 / 09:54:41 / cg"
+ "Modified: / 28-06-2019 / 08:44:21 / Claus Gittinger"
!
doCallAction
@@ -2044,17 +2175,19 @@
|val|
- aHandlerBlock argumentCount == 0 ifTrue:[
- "0-arg handler or any object - not interested in the exception argument"
- val := aHandlerBlock value
+ (aHandlerBlock isBlockWithArgumentCount:1) ifTrue:[
+ "1-arg handler - pass myself as exception argument"
+ val := aHandlerBlock value:self.
] ifFalse:[
- "1-arg handler - pass myself as exception argument"
- val := aHandlerBlock value:self.
+ "0-arg handler or any object - not interested in the exception argument"
+ val := aHandlerBlock value
].
"handler fall through - is just like a #return:(aHandlerBlock value)"
self return:val
+
+ "Modified: / 18-03-2017 / 18:08:40 / stefan"
!
doRaise
@@ -2075,7 +2208,9 @@
"is nil a valid originator? If so, we need an extra
instanceVariable to record the originator setting"
originator isNil ifTrue:[
- originator := suspendedContext homeReceiver
+ suspendedContext notNil ifTrue:[
+ originator := suspendedContext homeReceiver
+ ].
].
signal isNil ifTrue:[
@@ -2246,6 +2381,16 @@
"Modified: / 10-08-2010 / 09:55:00 / cg"
!
+raiseRequestErrorString:errorString
+ "actually raise a proceedable exception."
+
+ <resource: #skipInDebuggersWalkBack>
+
+ ^ self raiseRequestErrorString:errorString in:thisContext sender
+
+ "Created: / 01-02-2019 / 00:49:26 / Claus Gittinger"
+!
+
raiseRequestErrorString:errorString in:aContext
"actually raise a proceedable exception."
@@ -2281,17 +2426,28 @@
"Created: / 10-08-2010 / 09:36:45 / cg"
!
+raiseRequestWith:aParameter
+ "actually raise a proceedable exception."
+
+ <context: #return>
+
+ self raiseRequestWith:aParameter in:thisContext sender.
+!
+
raiseRequestWith:aParameter errorString:aString
"raise the signal proceedable.
The argument, aString is used as messageText,
aParameter is passed as exception parameter."
<context: #return>
+ <resource: #skipInDebuggersWalkBack>
^ (self
- suspendedContext:thisContext sender parameter:aParameter errorString:aString)
- raiseRequest.
- "Created: / 23.7.1999 / 14:08:57 / stefan"
+ suspendedContext:thisContext sender parameter:aParameter errorString:aString)
+ raiseRequest.
+
+ "Created: / 23-07-1999 / 14:08:57 / stefan"
+ "Modified: / 22-07-2019 / 13:05:20 / Claus Gittinger"
!
raiseRequestWith:aParameter errorString:aString in:aContext
@@ -2337,7 +2493,6 @@
<context: #return>
<resource: #skipInDebuggersWalkBack>
-
raiseContext := thisContext.
(suspendedContext isNil or:[handlerContext notNil]) ifTrue:[
suspendedContext := raiseContext sender
@@ -2348,6 +2503,22 @@
"Modified: / 19-04-2013 / 09:37:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+raiseSignalIn:aContext
+ "actually raise an exception (whatever the proceedability is)."
+
+ <context: #return>
+ <resource: #skipInDebuggersWalkBack>
+
+ raiseContext := aContext.
+ (suspendedContext isNil or:[handlerContext notNil]) ifTrue:[
+ suspendedContext := raiseContext sender
+ ].
+ proceedable := self mayProceed.
+ ^ self doRaise
+
+ "Modified: / 19-04-2013 / 09:37:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
raiseWith:aParameter errorString:aString
"raise the signal nonproceedable.
The argument, aString is used as messageText,
@@ -2356,8 +2527,8 @@
<context: #return>
^ (self
- suspendedContext:thisContext sender parameter:aParameter errorString:aString)
- raise.
+ suspendedContext:thisContext sender parameter:aParameter errorString:aString)
+ raise.
!
raiseWith:aParameter errorString:aString in:aContext
@@ -2391,6 +2562,17 @@
^ self doRaise
"Created: / 10-08-2010 / 09:50:54 / cg"
+!
+
+reRaise
+ "reraise a previously caught exception (on the current context)"
+
+ <context: #return>
+
+ ^ self doRaise
+
+
+
! !
!GenericException methodsFor:'setup'!
@@ -2442,6 +2624,14 @@
!GenericException methodsFor:'testing'!
+isBridgeException
+ "do not make this an extension method of the Bridge-package"
+
+ ^ false
+
+ "Created: / 28-05-2018 / 12:53:43 / Claus Gittinger"
+!
+
isError
^ false
!
@@ -2462,6 +2652,20 @@
I.e. a global error handler should reject and let a debugger get control."
^ self class isProgramError
+!
+
+isQuery
+ ^ self creator isQuerySignal
+
+ "Created: / 21-07-2017 / 00:43:38 / cg"
+ "Modified: / 21-07-2017 / 20:27:24 / cg"
+ "Modified: / 25-07-2017 / 16:52:34 / stefan"
+!
+
+isTimeoutException
+ ^ false
+
+ "Created: / 28-01-2019 / 21:41:29 / Claus Gittinger"
! !
!GenericException class methodsFor:'documentation'!
@@ -2472,11 +2676,6 @@
version_CVS
^ '$Header$'
-!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
! !