"====================================================================== | | Exception handling classes Definitions | | $Revision: 1.7.5$ | $Date: 2000/05/28 16:56:52$ | $Author: pb$ | ======================================================================" "====================================================================== | | Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc. | Written by Paolo Bonzini. | | This file is part of the GNU Smalltalk class library. | | The GNU Smalltalk class library is free software; you can redistribute it | and/or modify it under the terms of the GNU Lesser General Public License | as published by the Free Software Foundation; either version 2.1, or (at | your option) any later version. | | The GNU Smalltalk class library is distributed in the hope that it will be | useful, but WITHOUT ANY WARRANTY; without even the implied warranty of | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser | General Public License for more details. | | You should have received a copy of the GNU Lesser General Public License | along with the GNU Smalltalk class library; see the file COPYING.LESSER. | If not, write to the Free Software Foundation, 59 Temple Place - Suite | 330, Boston, MA 02111-1307, USA. | ======================================================================" "Create these symbols. They'll be defined at the end of the file. Also create some classes" Smalltalk at: #ExAll put: nil. Smalltalk at: #ExHalt put: nil. Smalltalk at: #ExError put: nil. Smalltalk at: #ExDoesNotUnderstand put: nil. Smalltalk at: #ExUserBreak put: nil. Object subclass: #ExceptionHandler instanceVariableNames: 'onDoBlock exitBlock handlerBlock context' classVariableNames: '' poolDictionaries: '' category: 'Language-Exceptions'. Object subclass: #Signal instanceVariableNames: 'exception arguments resumeBlock exitBlock onDoBlock' classVariableNames: '' poolDictionaries: '' category: 'Language-Exceptions'. Object subclass: #TrappableEvent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Language-Exceptions'! Object subclass: #ActiveHandlersList instanceVariableNames: 'active ptr stack' classVariableNames: '' poolDictionaries: '' category: 'Language-Exceptions'. TrappableEvent subclass: #Exception instanceVariableNames: 'parent resumable description defaultHandler' classVariableNames: '' poolDictionaries: '' category: 'Language-Exceptions'. TrappableEvent subclass: #ExceptionCollection instanceVariableNames: 'collection' classVariableNames: '' poolDictionaries: '' category: 'Language-Exceptions'! "The classes were created. Add their comments." ExceptionHandler comment: ' I am used internally by the exception handling system. My instances record the handler for an exception, the receiver of the #on:do:... method that established that handler, and a block that leaves that #on:do:... method'. TrappableEvent comment: ' I am an abstract class for arguments passed to #on:do:... methods in BlockClosure. I define a bunch of methods that apply to Exceptions and ExceptionCollections: they allow you to create ExceptionCollections and examine all the exceptions to be trapped.'. ActiveHandlersList comment: ' I track the active handlers for a given exception. I can add one, remove one, and track which are already executing (used for implementing #outer and #pass); I can also handle a stack that saves the state of the list around invocations of #on:do:... methods.'. Exception comment: ' My instances describe a single event that can be trapped using #on:do:..., contain whether such execution can be resumed after such an event, a description of what happened, and a block that is used as an handler by default. Using my methods you can raise exceptions and create new exceptions. Exceptions are organized in a kind of hierarchy (different from the class hierarchy): intercepting an exception will intercept all its children too.'. ExceptionCollection comment: ' My instances are not real exceptions: they can only be used as arguments to #on:do:... methods in BlockClosure. They act as shortcuts that allows you to use the same handler for many exceptions without having to write duplicate code'. Signal comment: ' My instances describe an exception that has happened, and are passed to exception handlers. Apart from containing information on the generated exception and its arguments, they contain methods that allow you to resume execution, leave the #on:do:... snippet, and pass the exception to an handler with a lower priority.'! !ExceptionHandler methodsFor: 'accessing'! signal: exc withArguments: args resume: aBoolean "Signal the given exception with the given argument. aBoolean indicates the action (either resuming the receiver of #on:do:... or exiting it) upon leaving from the handler block." | sig | sig := (Signal new) resumeBlock: [ :object | ^object ] onDoBlock: onDoBlock exitBlock: exitBlock arguments: args exception: exc. ^aBoolean ifTrue: [ handlerBlock value: sig ] ifFalse: [ exitBlock value: (handlerBlock value: sig) ]. ! isDisabled "Answer whether the receiver is disabled by a #valueWithUnwind." ^context ~~ ContextPart lastUnwindPoint ! onDoBlock: wdBlock exitBlock: eBlock handlerBlock: hBlock "Initialize the receiver's instance variables." context := ContextPart lastUnwindPoint. onDoBlock := wdBlock. exitBlock := eBlock. handlerBlock := hBlock. ^self ! ! !ExceptionHandler class methodsFor: 'instance creation'! onDoBlock: wdBlock exitBlock: eBlock handlerBlock: hBlock "Answer an ExceptionHandler instance with the given values for its instance variables." ^self new onDoBlock: wdBlock exitBlock: eBlock handlerBlock: hBlock ! ! !TrappableEvent methodsFor: 'instance creation'! , aTrappableEvent "Answer an ExceptionCollection containing all the exceptions in the receiver and all the exceptions in aTrappableEvent" ^ExceptionCollection new add: self; add: aTrappableEvent; yourself ! ! !TrappableEvent methodsFor: 'enumerating'! allExceptionsDo: aBlock "Execute aBlock, passing it an Exception for every exception in the receiver." self subclassResponsibility ! handles: exception "Answer whether the receiver handles `exception'." self subclassResponsibility ! ! !TrappableEvent methodsFor: 'private'! registerHandler: anExceptionHandler "Private - Register anExceptionHandler as an exception handler for the receiver" self subclassResponsibility ! whenSignalledIn: onDoBlock do: handlerBlock exitBlock: exitBlock "Private - Create an ExceptionHandler from the arguments and register it" self registerHandler: (ExceptionHandler onDoBlock: onDoBlock exitBlock: exitBlock handlerBlock: handlerBlock) ! ! !Exception methodsFor: 'basic'! copy "Answer a copy of the receiver" ^super copy description: self description copy; yourself ! ! !Exception methodsFor: 'accessing'! defaultHandler "Answer the default handler for the receiver" ^defaultHandler ! defaultHandler: aBlock "Set the default handler of the receiver to aBlock. A Signal object will be passed to aBlock" defaultHandler := aBlock ! description "Answer a description of the receiver" ^description ! description: aString "Set the description of the receiver to aString" description := aString ! messageText "Answer a description of the receiver" ^description ! parent "Answer the parent of the receiver" ^parent ! isResumable "Answer true if the receiver is resumable" ^resumable ! isResumable: aBoolean "Set the resumable flag of the receiver to aBoolean" resumable := aBoolean ! ! !Exception methodsFor: 'instance creation'! newChild "Answer a child exception of the receiver. Its properties are set to those of the receiver" ^self species basicNew description: self description copy; isResumable: self isResumable; defaultHandler: nil; parent: self; yourself ! ! !ActiveHandlersList class methodsFor: 'instance creation'! new "Answer a new instance of the receiver and initialize it" ^self basicNew initialize ! ! !ActiveHandlersList methodsFor: 'list handling'! add: handler "Add another handler for the exception to which the receiver is attached." ^active add: handler beforeIndex: ptr. ! atEnd "Answer whether all handlers have been activated and the system must activate the default handler" ^ptr > active size ! next "Answer the next handler to be activated, and advance the pointer." ptr > active size ifTrue: [ ^nil ]. ptr := ptr + 1. ^active at: (ptr - 1). ! peek "Look which is the next handler to be activated, but don't advance the pointer." ptr > active size ifTrue: [ ^nil ]. ^active at: ptr. ! push "Push on the state stack a snapshot of the current handlers" stack add: (active copy -> ptr) ! pop "Pop from the state stack a snapshot of the current handlers" | state | stack isEmpty ifTrue: [ active := OrderedCollection new. ptr := 1. ] ifFalse: [ state := stack removeLast. active := state key. ptr := state value ]. ! reset "Reinstate all handlers" ptr := 1 ! ! !ActiveHandlersList methodsFor: 'private'! initialize stack := OrderedCollection new. self pop ! ! !Exception methodsFor: 'exception handling'! signal "Raise the exception described by the receiver, passing no parameters" ^self nextHandler signal: self withArguments: #() resume: self isResumable ! signalWith: arg "Raise the exception described by the receiver, passing the parameter arg" | args | (args := Array new: 1) at: 1 put: arg. ^self nextHandler signal: self withArguments: args resume: self isResumable ! signalWith: arg with: arg2 "Raise the exception described by the receiver, passing the parameters arg and arg2" | args | (args := Array new: 2) at: 1 put: arg; at: 2 put: arg2. ^self nextHandler signal: self withArguments: args resume: self isResumable ! signalWithArguments: args "Raise the exception described by the receiver, passing the parameters in args" ^self nextHandler signal: self withArguments: args resume: self isResumable ! ! !Exception methodsFor: 'enumerating'! allExceptionsDo: aBlock "Private - Evaluate aBlock for every exception in the receiver. As it contains just one exception, evaluate it just once, passing the receiver" aBlock value: self ! handles: exception "Answer whether the receiver handles `exception'." ^exception == self ! ! !Exception methodsFor: 'private'! hasHandler "Private - Determine whether the receiver exception has another handler for the same exception." self class handlers at: self ifPresent: [:val | "If there are no handlers, of course, proceed with the parent. But the handler is NOT valid even if there is an intervening call to #valueWithUnwind, so that's why we check with #isDisabled." ^val atEnd ifTrue: [ false ] ifFalse: [ val peek isDisabled not ] ]. ^false ! nextHandler "Private - Answer an handler for the anException exception. If it cannot found, look for an handler for its parent, until one is found or ExAll if reached and there is no handler. In this case, answer the default handler for anException. The answer is given as an ExceptionHandler." | exc handler | exc := self. [ self class handlers at: exc ifPresent: [:val | "If there are no handlers, of course, proceed with the parent. But the handler is NOT valid even if there is an intervening call to #valueWithUnwind, so that's why we check with #isDisabled." val atEnd ifFalse: [ val peek isDisabled ifFalse: [ ^val next ] ] ]. exc == ExAll ] whileFalse: [ exc := exc parent ]. ^ExceptionHandler onDoBlock: nil exitBlock: nil handlerBlock: self actualDefaultHandler ! passWithArguments: args "Raise the exception described by the receiver, passing the parameters in args, and without returning control to the caller" ^self nextHandler signal: self withArguments: args resume: false ! resetHandlers "Private - Reset the handlers for the receiver; that is, the next handler used will be the first that was declared" self class handlers at: self ifPresent: [:val | val reset] ! actualDefaultHandler "Private - Answer the default handler for the receiver. It differs from #defaultHandler because if the default handler of the parent has to be used #defaultHandler answers nil, while #actualDefaultHandler calls #actualDefaultHandler for the parent and answers its result" ^defaultHandler isNil ifTrue: [self parent actualDefaultHandler] ifFalse: [defaultHandler] ! registerHandler: anExceptionHandler "Private - Register anExceptionHandler as the information on a handler for the receiver" | handlerList | handlerList := self class handlers at: self ifAbsentPut: [ ActiveHandlersList new ]. handlerList add: anExceptionHandler ! ! !Exception methodsFor: 'private - accessing'! parent: anException "Private - Set the parent of the receiver to anException" parent := anException ! ! !Exception class methodsFor: 'instance creation'! new "Create a new exception whose parent is ExAll" ^ExAll newChild ! ! !Exception class methodsFor: 'private'! handlers "Private, class - Answer the currently active handlers" ^Processor activeProcess exceptionHandlers ! handlers: handlers "Private, class - Set the currently active handlers to the argument" Processor activeProcess exceptionHandlers: handlers ! resetAllHandlers "Private, class - Reset the handlers for all the exceptions; that is, the next handlers used will be the first to be declared" self handlers do: [:each | each reset] ! initialize "Private, class - Initialize the system exceptions" | nargs | (ExAll := self basicNew) description: 'An exception has occurred'; isResumable: true; defaultHandler: [:sig | | receiver description | receiver := sig argumentCount > 1 ifTrue: [ sig arguments at: 2 ] ifFalse: [ nil ]. description := sig argumentCount > 0 ifTrue: [ sig argument ] ifFalse: [ sig description ]. receiver primError: description ]. (ExError := ExAll newChild) description: '#error: was sent'. (ExHalt := ExAll newChild) description: 'halt encountered'. (ExUserBreak := ExAll newChild) description: 'interrupted!!!'; isResumable: false. (ExDoesNotUnderstand := ExError newChild) description: 'did not understand selector'; defaultHandler: [:sig | (sig arguments at: 2) primError: ('did not understand ', sig argument printString) ] ! ! !ExceptionCollection class methodsFor: 'instance creation'! new "Private - Answer a new, empty ExceptionCollection" ^self basicNew collection: Set new ! ! !ExceptionCollection methodsFor: 'enumerating'! allExceptionsDo: aBlock "Private - Evaluate aBlock for every exception in the receiver. Answer the receiver" collection do: aBlock ! handles: exception "Answer whether the receiver handles `exception'." ^collection includes: exception ! ! !ExceptionCollection methodsFor: 'private'! registerHandler: eh self allExceptionsDo: [:exc | exc registerHandler: eh ] ! ! !ExceptionCollection methodsFor: 'private - accessing'! add: aTrappableEvent "Private - Add aTrappableEvent to the receiver and answer aTrappableEvent" aTrappableEvent allExceptionsDo: [ :exc | collection add: exc ]. ^aTrappableEvent ! collection: aSet "Private - Set the collection of exception included in the receiver to aSet" collection := aSet. ^self ! ! !Signal methodsFor: 'accessing'! argumentCount "Answer how many arguments the receiver has" ^arguments size ! argument "Answer the first argument of the receiver" ^arguments at: 1 ! arguments "Answer the arguments of the receiver" ^arguments ! description "Answer the description of the raised exception" ^self exception description ! messageText "Answer the description of the raised exception" ^self exception messageText ! exception "Answer the exception that was raised" ^exception ! ! !Signal methodsFor: 'exception handling'! defaultAction "Execute the default handler for the raised exception" self exception actualDefaultHandler value: self ! isNested "Answer whether the current exception handler is within the scope of another handler for the same exception." ^self exception hasHandler ! outer "Raise the exception that instantiated the receiver, passing the same parameters. If the receiver is resumable and the evaluated exception action resumes then the result returned from #outer will be the resumption value of the evaluated exception action. If the receiver is not resumable or if the exception action does not resume then this message will not return, and #outer will be equivalent to #pass." ^self exception signalWithArguments: self arguments ! pass "Yield control to the enclosing exception action for the receiver. Similar to #outer, but control does not return to the currently active exception handler." ^self exception passWithArguments: self arguments ! resume "If the exception is resumable, resume the execution of the block that raised the exception; the method that was used to signal the exception will answer the receiver. Use this method IF AND ONLY IF you know who caused the exception and if it is possible to resume it in that particular case" self exception isResumable ifFalse: [ self primError: 'Exception not resumable - #resume failed' ]. self exception resetHandlers. resumeBlock value: self ! resume: anObject "If the exception is resumable, resume the execution of the block that raised the exception; the method that was used to signal the exception will answer anObject. Use this method IF AND ONLY IF you know who caused the exception and if it is possible to resume it in that particular case" self exception isResumable ifFalse: [ self primError: 'Exception not resumable - #resume: failed' ]. self exception resetHandlers. resumeBlock value: anObject ! resignalAs: replacementException "Reinstate all handlers and execute the handler for `replacementException'; control does not return to the currently active exception handler. The new Signal object that is created has the same arguments as the receiver (this might or not be correct -- if it isn't you can use an idiom such as `sig retryUsing: [ replacementException signal ])" Exception resetAllHandlers. replacementException passWithArguments: self arguments. ! retry "Re-execute the receiver of the #on:do: message. All handlers are reinstated: watch out, this can easily cause an infinite loop." onDoBlock isNil ifTrue: [ self primError: 'No exception handler effective - #retry failed' ]. Exception resetAllHandlers. self return: onDoBlock value ! retryUsing: aBlock "Execute aBlock reinstating all handlers, and return its result from the #signal method." Exception resetAllHandlers. self return: aBlock value ! return "Exit the #on:do: snippet, answering anObject to its caller" exitBlock isNil ifTrue: [ self primError: 'No exception handler effective - #return failed' ]. exitBlock value: nil ! return: anObject "Exit the #on:do: snippet, answering anObject to its caller" exitBlock isNil ifTrue: [ self primError: 'No exception handler effective - #return: failed' ]. exitBlock value: anObject ! ! !Signal methodsFor: 'private'! resumeBlock: rBlock onDoBlock: wdBlock exitBlock: eBlock arguments: args exception: exc "Private - Set the block to be executed to leave the #on:do:... message to eBlock; set the exception that was raised to exc; set its arguments to args set the receiver of the #on:do:... message to wdBlock; set the block to be executed to resume execution to rBlock" resumeBlock := rBlock. onDoBlock := wdBlock. exitBlock := eBlock. arguments := args. exception := exc. ^self ! ! !BlockClosure methodsFor: 'exception handling'! ensure: aBlock "Evaluate the receiver; when any exception is signaled exit returning the result of evaluating aBlock; if no exception is raised, return the result of evaluating aBlock when the receiver has ended" | completing | completing := false. ^[ self value. completing := true. aBlock value ] on: ExAll do: [:sig | completing ifFalse: [ completing := true. aBlock value ]. sig pass ] ! on: anException do: aBlock "Evaluate the receiver; when anException is signaled, evaluate aBlock passing a Signal describing the exception. Answer either the result of evaluating the receiver or the parameter of a Signal>>#return:" | exitBlock | Exception handlers do: [ :each | each push ]. exitBlock := [:returnValue | Exception handlers do: [ :each | each pop ]. ^returnValue]. anException whenSignalledIn: self do: aBlock exitBlock: exitBlock. exitBlock value: self value ! on: e1 do: b1 on: e2 do: b2 "Evaluate the receiver; when e1 or e2 are signaled, evaluate respectively b1 or b2, passing a Signal describing the exception. Answer either the result of evaluating the receiver or the argument of a Signal>>#return:" | exitBlock | Exception handlers do: [ :each | each push ]. exitBlock := [:returnValue | Exception handlers do: [ :each | each pop ]. ^returnValue]. e1 whenSignalledIn: self do: b1 exitBlock: exitBlock. e2 whenSignalledIn: self do: b2 exitBlock: exitBlock. exitBlock value: self value ! on: e1 do: b1 on: e2 do: b2 on: e3 do: b3 "Evaluate the receiver; when e1, e2 or e3 are signaled, evaluate respectively b1, b2 or b3, passing a Signal describing the exception. Answer either the result of evaluating the receiver or the parameter of a Signal>>#return:" | exitBlock | Exception handlers do: [ :each | each push ]. exitBlock := [:returnValue | Exception handlers do: [ :each | each pop ]. ^returnValue]. e1 whenSignalledIn: self do: b1 exitBlock: exitBlock. e2 whenSignalledIn: self do: b2 exitBlock: exitBlock. e3 whenSignalledIn: self do: b3 exitBlock: exitBlock. exitBlock value: self value ! on: e1 do: b1 on: e2 do: b2 on: e3 do: b3 on: e4 do: b4 "Evaluate the receiver; when e1, e2, e3 or e4 are signaled, evaluate respectively b1, b2, b3 or b4, passing a Signal describing the exception. Answer either the result of evaluating the receiver or the parameter of a Signal>>#return:" | exitBlock | Exception handlers do: [ :each | each push ]. exitBlock := [:returnValue | Exception handlers do: [ :each | each pop ]. ^returnValue]. e1 whenSignalledIn: self do: b1 exitBlock: exitBlock. e2 whenSignalledIn: self do: b2 exitBlock: exitBlock. e3 whenSignalledIn: self do: b3 exitBlock: exitBlock. e4 whenSignalledIn: self do: b4 exitBlock: exitBlock. exitBlock value: self value ! on: e1 do: b1 on: e2 do: b2 on: e3 do: b3 on: e4 do: b4 on: e5 do: b5 "Evaluate the receiver; when e1, e2, e3, e4 or e5 are signaled, evaluate respectively b1, b2, b3, b4 or b5, passing a Signal describing the exception. Answer either the result of evaluating the receiver or the parameter of a Signal>>#return:" | exitBlock | Exception handlers do: [ :each | each push ]. exitBlock := [:returnValue | Exception handlers do: [ :each | each pop ]. ^returnValue]. e1 whenSignalledIn: self do: b1 exitBlock: exitBlock. e2 whenSignalledIn: self do: b2 exitBlock: exitBlock. e3 whenSignalledIn: self do: b3 exitBlock: exitBlock. e4 whenSignalledIn: self do: b4 exitBlock: exitBlock. e5 whenSignalledIn: self do: b5 exitBlock: exitBlock. exitBlock value: self value ! ifCurtailed: aBlock "Evaluate the receiver; when any exception is signaled exit returning the result of evaluating aBlock; if no exception is raised, return the result of evaluating the receiver" ^self on: ExAll do: [:sig | aBlock value. sig pass ] ! ! Exception initialize! !Object methodsFor: 'built ins'! primError: message "This might start the debugger... Note that we use #basicPrint 'cause #printOn: might invoke an error." Transcript initialize. stdout flush. self basicPrint. stdout nextPutAll: ' error: '; nextPutAll: message; nl. ContextPart backtraceOn: stdout; unwind ! doesNotUnderstand: aMessage "Called by the system when a selector was not found. message is a Message containing information on the receiver" ExDoesNotUnderstand signalWith: aMessage selector with: self ! error: message "Display a walkback for the receiver, with the given error message. Signal ExError" ExError signalWith: message with: self ! halt: message "Display a walkback for the receiver, with the given error message. Signal ExHalt" ExHalt signalWith: message with: self ! userInterrupt "Display a walkback for the receiver, signalling ExUserBreak." ExUserBreak signalWith: 'interrupted! !' with: self ! ! " An example of exception handling follows: | loopExitException random | random := Random new. loopExitException := ExAll newChild. ^[ [ random next < 0.2 ifTrue: [ loopExitException signal ]. 1 error: 'hello!' ] repeat ] on: loopExitException do: [:sig | sig return: 'bye' ] on: ExError do: [:sig | sig arguments printNl. sig resume ] "