Smalltalk › Squeak › Squeak - Dev

[squeak-dev] The Inbox: Exceptions-eem.12.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

[squeak-dev] The Inbox: Exceptions-eem.12.mcz

A new version of Exceptions was added to project The Inbox:
http://source.squeak.org/inbox/Exceptions-eem.12.mcz

==================== Summary ====================

Name: Exceptions-eem.12
Author: eem
Time: 5 September 2009, 3:36:07 am
UUID: 222baa54-c057-4244-8484-c4d78fb1fca1
Ancestors: Exceptions-ar.11

First package of eight in closure compiler fixes 9/5/2009.

Add reachedDefaultHandler to MessageNotUnderstood so that doesNotUnderstand: can support resume:.

==================== Snapshot ====================

SystemOrganization addCategory: #'Exceptions-Kernel'!
SystemOrganization addCategory: #'Exceptions-Extensions'!
SystemOrganization addCategory: #'Exceptions-Tests'!

TestCase subclass: #ExceptionTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Tests'!

----- Method: ExceptionTests>>assertSuccess: (in category 'private') -----
assertSuccess: anExceptionTester
self should: [ ( anExceptionTester suiteLog first) endsWith: 'succeeded'].!

----- Method: ExceptionTests>>testDoubleOuterPass (in category 'testing-ExceptionTester') -----
testDoubleOuterPass
self assertSuccess: (ExceptionTester new runTest: #doubleOuterPassTest ) !

----- Method: ExceptionTests>>testDoublePassOuter (in category 'testing-ExceptionTester') -----
testDoublePassOuter
self assertSuccess: (ExceptionTester new runTest: #doublePassOuterTest ) !

----- Method: ExceptionTests>>testDoubleResume (in category 'testing-ExceptionTester') -----
testDoubleResume
self assertSuccess: (ExceptionTester new runTest: #doubleResumeTest ) !

----- Method: ExceptionTests>>testNoTimeout (in category 'testing') -----
testNoTimeout
self assertSuccess: (ExceptionTester new runTest: #simpleNoTimeoutTest ) !

----- Method: ExceptionTests>>testNonResumableFallOffTheEndHandler (in category 'testing-ExceptionTester') -----
testNonResumableFallOffTheEndHandler
self assertSuccess: (ExceptionTester new runTest: #nonResumableFallOffTheEndHandler ) !

----- Method: ExceptionTests>>testNonResumableOuter (in category 'testing-outer') -----
testNonResumableOuter

self should: [
[Error signal. 4]
on: Error
do: [:ex | ex outer. ex return: 5]
] raise: Error
!

----- Method: ExceptionTests>>testNonResumablePass (in category 'testing-outer') -----
testNonResumablePass

self should: [
[Error signal. 4]
on: Error
do: [:ex | ex pass. ex return: 5]
] raise: Error
!

----- Method: ExceptionTests>>testResumableFallOffTheEndHandler (in category 'testing-ExceptionTester') -----
testResumableFallOffTheEndHandler
self assertSuccess: (ExceptionTester new runTest: #resumableFallOffTheEndHandler ) !

----- Method: ExceptionTests>>testResumableOuter (in category 'testing-outer') -----
testResumableOuter

| result |
result := [Notification signal. 4]
on: Notification
do: [:ex | ex outer. ex return: 5].
self assert: result == 5
!

----- Method: ExceptionTests>>testResumablePass (in category 'testing-outer') -----
testResumablePass

| result |
result := [Notification signal. 4]
on: Notification
do: [:ex | ex pass. ex return: 5].
self assert: result == 4
!

----- Method: ExceptionTests>>testSignalFromHandlerActionTest (in category 'testing-ExceptionTester') -----
testSignalFromHandlerActionTest
self assertSuccess: (ExceptionTester new runTest: #signalFromHandlerActionTest ) !

----- Method: ExceptionTests>>testSimpleEnsure (in category 'testing-ExceptionTester') -----
testSimpleEnsure
self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTest ) !

----- Method: ExceptionTests>>testSimpleEnsureTestWithError (in category 'testing-ExceptionTester') -----
testSimpleEnsureTestWithError
self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithError ) !

----- Method: ExceptionTests>>testSimpleEnsureTestWithNotification (in category 'testing-ExceptionTester') -----
testSimpleEnsureTestWithNotification
self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithNotification ) !

----- Method: ExceptionTests>>testSimpleEnsureTestWithUparrow (in category 'testing-ExceptionTester') -----
testSimpleEnsureTestWithUparrow
self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithUparrow ) !

----- Method: ExceptionTests>>testSimpleIsNested (in category 'testing-ExceptionTester') -----
testSimpleIsNested
self assertSuccess: (ExceptionTester new runTest: #simpleIsNestedTest ) !

----- Method: ExceptionTests>>testSimpleOuter (in category 'testing-ExceptionTester') -----
testSimpleOuter
self assertSuccess: (ExceptionTester new runTest: #simpleOuterTest ) !

----- Method: ExceptionTests>>testSimplePass (in category 'testing-ExceptionTester') -----
testSimplePass
self assertSuccess: (ExceptionTester new runTest: #simplePassTest ) !

----- Method: ExceptionTests>>testSimpleResignalAs (in category 'testing-ExceptionTester') -----
testSimpleResignalAs
self assertSuccess: (ExceptionTester new runTest: #simpleResignalAsTest ) !

----- Method: ExceptionTests>>testSimpleResume (in category 'testing-ExceptionTester') -----
testSimpleResume
self assertSuccess: (ExceptionTester new runTest: #simpleResumeTest ) !

----- Method: ExceptionTests>>testSimpleRetry (in category 'testing-ExceptionTester') -----
testSimpleRetry
self assertSuccess: (ExceptionTester new runTest: #simpleRetryTest ) !

----- Method: ExceptionTests>>testSimpleRetryUsing (in category 'testing-ExceptionTester') -----
testSimpleRetryUsing
self assertSuccess: (ExceptionTester new runTest: #simpleRetryUsingTest ) !

----- Method: ExceptionTests>>testSimpleReturn (in category 'testing-ExceptionTester') -----
testSimpleReturn
self assertSuccess: (ExceptionTester new runTest: #simpleReturnTest ) !

----- Method: ExceptionTests>>testTimeoutWithZeroDuration (in category 'testing') -----
testTimeoutWithZeroDuration
self assertSuccess: (ExceptionTester new runTest: #simpleTimeoutWithZeroDurationTest ) !

TestCase subclass: #ProcessTerminateBug
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Tests'!

----- Method: ProcessTerminateBug>>testSchedulerTermination (in category 'tests') -----
testSchedulerTermination
| process sema gotHere sema2 |
gotHere := false.
sema := Semaphore new.
sema2 := Semaphore new.
process := [
sema signal.
sema2 wait.
"will be suspended here"
gotHere := true. "e.g., we must *never* get here"
] forkAt: Processor activeProcess priority.
sema wait. "until process gets scheduled"
process terminate.
sema2 signal.
Processor yield. "will give process a chance to continue and
horribly screw up"
self assert: gotHere not.
!

----- Method: ProcessTerminateBug>>testUnwindFromActiveProcess (in category 'tests') -----
testUnwindFromActiveProcess
| sema process |
sema := Semaphore forMutualExclusion.
self assert:(sema isSignaled).
process := [
sema critical:[
self deny: sema isSignaled.
Processor activeProcess terminate.
]
] forkAt: Processor userInterruptPriority.
self assert: sema isSignaled.!

----- Method: ProcessTerminateBug>>testUnwindFromForeignProcess (in category 'tests') -----
testUnwindFromForeignProcess
| sema process |
sema := Semaphore forMutualExclusion.
self assert: sema isSignaled.
process := [
sema critical:[
self deny: sema isSignaled.
sema wait. "deadlock"
]
] forkAt: Processor userInterruptPriority.
self deny: sema isSignaled.
"This is for illustration only - the BlockCannotReturn cannot
be handled here (it's truncated already)"
self shouldnt: [process terminate] raise: BlockCannotReturn.
self assert: sema isSignaled.
!

Object subclass: #Exception
instanceVariableNames: 'messageText tag signalContext handlerContext outerContext'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!Exception commentStamp: '<historical>' prior: 0!
This is the main class used to implement the exception handling system (EHS). It plays two distinct roles: that of the exception, and that of the exception handler. More specifically, it implements the bulk of the protocols laid out in the ANSI specification - those protocol names are reflected in the message categories.

Exception is an abstract class. Instances should neither be created nor trapped. In most cases, subclasses should inherit from Error or Notification rather than directly from Exception.

In implementing this EHS, The Fourth Estate Inc. incorporated some ideas and code from Craig Latta's EHS. His insights were crucial in allowing us to implement BlockContext>>valueUninterruptably (and by extension, #ensure: and #ifCurtailed:), and we imported the following methods with little or no modification:

ContextPart>>terminateTo:
ContextPart>>terminate
MethodContext>>receiver:
MethodContext>>answer:

Thanks, Craig!!!

Exception subclass: #Abort
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: Abort>>defaultAction (in category 'as yet unclassified') -----
defaultAction
"No one has handled this error, but now give them a chance to decide how to debug it. If none handle this either then open debugger (see UnhandedError-defaultAction)"

UnhandledError signalForException: self!

Exception subclass: #Error
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!Error commentStamp: '<historical>' prior: 0!
>From the ANSI standard:
This protocol describes the behavior of instances of class Error. These are used to represent error conditions that prevent the normal continuation of processing. Actual error exceptions used by an application may be subclasses of this class.
As Error is explicitly specified to be subclassable, conforming implementations must implement its behavior in a non-fragile manner.

Additional notes:
Error>defaultAction uses an explicit test for the presence of the Debugger class to decide whether or not it is in development mode. In the future, TFEI hopes to enhance the semantics of #defaultAction to improve support for pluggable default handlers.!

Error subclass: #ArithmeticError
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

ArithmeticError subclass: #FloatingPointException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

ArithmeticError subclass: #ZeroDivide
instanceVariableNames: 'dividend'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!ZeroDivide commentStamp: '<historical>' prior: 0!
ZeroDivide may be signaled when a mathematical division by 0 is attempted.!

----- Method: ZeroDivide class>>dividend: (in category 'exceptionInstantiator') -----
dividend: argument
^self new dividend: argument; yourself!

----- Method: ZeroDivide>>dividend (in category 'exceptionDescription') -----
dividend
"Answer the number that was being divided by zero."

^dividend!

----- Method: ZeroDivide>>dividend: (in category 'exceptionBuilder') -----
dividend: argument
"Specify the number that was being divided by zero."

dividend := argument!

----- Method: ZeroDivide>>isResumable (in category 'exceptionDescription') -----
isResumable
"Determine whether an exception is resumable."

^true!

Error subclass: #AttemptToWriteReadOnlyGlobal
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!AttemptToWriteReadOnlyGlobal commentStamp: 'gh 5/2/2002 20:26' prior: 0!
This is a resumable error you get if you try to assign a readonly variable a value.
Name definitions in the module system can be read only and are then created using instances of ReadOnlyVariableBinding instead of Association.
See also LookupKey>>beReadWriteBinding and LookupKey>>beReadOnlyBinding.

!

----- Method: AttemptToWriteReadOnlyGlobal>>description (in category 'as yet unclassified') -----
description
"Return a textual description of the exception."

| desc mt |
desc := 'Error'.
^(mt := self messageText) == nil
ifTrue: [desc]
ifFalse: [desc, ': ', mt]!

----- Method: AttemptToWriteReadOnlyGlobal>>isResumable (in category 'as yet unclassified') -----
isResumable
^true!

Error subclass: #BlockCannotReturn
instanceVariableNames: 'result deadHome'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!BlockCannotReturn commentStamp: '<historical>' prior: 0!
This class is private to the EHS implementation. Its use allows for ensured execution to survive code such as:

[self doThis.
^nil]
ensure: [self doThat]

Signaling or handling this exception is not recommended.!

----- Method: BlockCannotReturn>>deadHome (in category 'accessing') -----
deadHome

^ deadHome!

----- Method: BlockCannotReturn>>deadHome: (in category 'accessing') -----
deadHome: context

deadHome := context!

----- Method: BlockCannotReturn>>defaultAction (in category 'exceptionDescription') -----
defaultAction

self messageText: 'Block cannot return'.
^super defaultAction!

----- Method: BlockCannotReturn>>isResumable (in category 'exceptionDescription') -----
isResumable

^true!

----- Method: BlockCannotReturn>>result (in category 'accessing') -----
result

^result!

----- Method: BlockCannotReturn>>result: (in category 'accessing') -----
result: r

result := r!

Error subclass: #EndOfStream
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Extensions'!

!EndOfStream commentStamp: '<historical>' prior: 0!
Signalled when ReadStream>>next encounters a premature end.!

----- Method: EndOfStream>>defaultAction (in category 'exceptionDescription') -----
defaultAction
"Answer ReadStream>>next default reply."

^ nil!

----- Method: EndOfStream>>isResumable (in category 'description') -----
isResumable
"EndOfStream is resumable, so ReadStream>>next can answer"

^ true!

----- Method: Error>>defaultAction (in category 'exceptionDescription') -----
defaultAction
"No one has handled this error, but now give them a chance to decide how to debug it. If none handle this either then open debugger (see UnhandedError-defaultAction)"

UnhandledError signalForException: self!

----- Method: Error>>isResumable (in category 'private') -----
isResumable
"Determine whether an exception is resumable."

^ false!

Error subclass: #FTPConnectionException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: FTPConnectionException>>defaultAction (in category 'as yet unclassified') -----
defaultAction

self resume!

----- Method: FTPConnectionException>>isResumable (in category 'as yet unclassified') -----
isResumable

^true!

Error subclass: #FileStreamException
instanceVariableNames: 'fileName'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

FileStreamException subclass: #CannotDeleteFileException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

FileStreamException subclass: #FileDoesNotExistException
instanceVariableNames: 'readOnly'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: FileDoesNotExistException class>>example (in category 'examples') -----
example
"FileDoesNotExistException example"

| result |
result := [(StandardFileStream readOnlyFileNamed: 'error42.log') contentsOfEntireFile]
on: FileDoesNotExistException
do: [:ex | 'No error log'].
Transcript show: result; cr!

----- Method: FileDoesNotExistException>>defaultAction (in category 'exceptionDescription') -----
defaultAction
"The default action taken if the exception is signaled."

^self readOnly
ifTrue: [StandardFileStream readOnlyFileDoesNotExistUserHandling: self fileName]
ifFalse: [StandardFileStream fileDoesNotExistUserHandling: self fileName]
!

----- Method: FileDoesNotExistException>>readOnly (in category 'accessing') -----
readOnly
^readOnly == true!

----- Method: FileDoesNotExistException>>readOnly: (in category 'accessing') -----
readOnly: aBoolean
readOnly := aBoolean!

FileStreamException subclass: #FileExistsException
instanceVariableNames: 'fileClass'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: FileExistsException class>>fileName:fileClass: (in category 'exceptionInstantiator') -----
fileName: aFileName fileClass: aClass
^ self new
fileName: aFileName;
fileClass: aClass!

----- Method: FileExistsException>>defaultAction (in category 'exceptionDescription') -----
defaultAction
"The default action taken if the exception is signaled."

^ self fileClass fileExistsUserHandling: self fileName
!

----- Method: FileExistsException>>fileClass (in category 'accessing') -----
fileClass
^ fileClass ifNil: [StandardFileStream]!

----- Method: FileExistsException>>fileClass: (in category 'accessing') -----
fileClass: aClass
fileClass := aClass!

----- Method: FileStreamException class>>fileName: (in category 'exceptionInstantiator') -----
fileName: aFileName
^self new fileName: aFileName!

----- Method: FileStreamException>>fileName (in category 'exceptionDescription') -----
fileName
^fileName!

----- Method: FileStreamException>>fileName: (in category 'exceptionBuilder') -----
fileName: aFileName
fileName := aFileName!

----- Method: FileStreamException>>isResumable (in category 'exceptionDescription') -----
isResumable
"Determine whether an exception is resumable."

^true!

----- Method: FileStreamException>>messageText (in category 'exceptionDescription') -----
messageText

"Return an exception's message text."

^messageText == nil
ifTrue: [fileName printString]
ifFalse: [messageText]!

Error subclass: #InvalidDirectoryError
instanceVariableNames: 'pathName'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: InvalidDirectoryError class>>pathName: (in category 'exceptionInstantiator') -----
pathName: badPathName
^self new pathName: badPathName!

----- Method: InvalidDirectoryError>>defaultAction (in category 'exceptionDescription') -----
defaultAction
"Return an empty list as the default action of signaling the occurance of an invalid directory."
^#()!

----- Method: InvalidDirectoryError>>pathName (in category 'accessing') -----
pathName
^pathName!

----- Method: InvalidDirectoryError>>pathName: (in category 'accessing') -----
pathName: badPathName
pathName := badPathName!

Error subclass: #MessageNotUnderstood
instanceVariableNames: 'message receiver reachedDefaultHandler'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!MessageNotUnderstood commentStamp: '<historical>' prior: 0!
This exception is provided to support Object>>doesNotUnderstand:.!

----- Method: MessageNotUnderstood>>defaultAction (in category 'exceptionDescription') -----
defaultAction
reachedDefaultHandler := true.
super defaultAction!

----- Method: MessageNotUnderstood>>initialize (in category 'initialize-release') -----
initialize
super initialize.
reachedDefaultHandler := false!

----- Method: MessageNotUnderstood>>isResumable (in category 'exceptionDescription') -----
isResumable
"Determine whether an exception is resumable."

^true!

----- Method: MessageNotUnderstood>>message (in category 'exceptionDescription') -----
message
"Answer the selector and arguments of the message that failed."

^message!

----- Method: MessageNotUnderstood>>message: (in category 'exceptionBuilder') -----
message: aMessage

message := aMessage!

----- Method: MessageNotUnderstood>>messageText (in category 'exceptionBuilder') -----
messageText
"Return an exception's message text."

^messageText == nil
ifTrue:
[message == nil
ifTrue: [super messageText]
ifFalse: [message lookupClass printString, '>>', message selector asString]]
ifFalse: [messageText]!

----- Method: MessageNotUnderstood>>reachedDefaultHandler (in category 'accessing') -----
reachedDefaultHandler
^reachedDefaultHandler!

----- Method: MessageNotUnderstood>>receiver (in category 'exceptionDescription') -----
receiver
"Answer the receiver that did not understand the message"

^ receiver!

----- Method: MessageNotUnderstood>>receiver: (in category 'exceptionBuilder') -----
receiver: obj

receiver := obj!

Error subclass: #MyResumableTestError
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Tests'!

----- Method: MyResumableTestError>>isResumable (in category 'exceptionDescription') -----
isResumable

^true!

Error subclass: #MyTestError
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Tests'!

Error subclass: #NonBooleanReceiver
instanceVariableNames: 'object'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: NonBooleanReceiver>>isResumable (in category 'signaledException') -----
isResumable

^true!

----- Method: NonBooleanReceiver>>object (in category 'accessing') -----
object
^object!

----- Method: NonBooleanReceiver>>object: (in category 'accessing') -----
object: anObject
object := anObject!

Error subclass: #SyntaxErrorNotification
instanceVariableNames: 'inClass code category doitFlag errorMessage location'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Extensions'!

----- Method: SyntaxErrorNotification class>>inClass:category:withCode:doitFlag: (in category 'exceptionInstantiator') -----
inClass: aClass category: aCategory withCode: codeString doitFlag: doitFlag
^ (self new
setClass: aClass
category: aCategory
code: codeString
doitFlag: doitFlag) signal!

----- Method: SyntaxErrorNotification class>>inClass:category:withCode:doitFlag:errorMessage:location: (in category 'exceptionInstantiator') -----
inClass: aClass category: aCategory withCode: codeString doitFlag: doitFlag errorMessage: errorString location: location
^ (self new
setClass: aClass
category: aCategory
code: codeString
doitFlag: doitFlag
errorMessage: errorString
location: location) signal!

----- Method: SyntaxErrorNotification>>category (in category 'accessing') -----
category
^category!

----- Method: SyntaxErrorNotification>>defaultAction (in category 'exceptionDescription') -----
defaultAction
^ToolSet debugSyntaxError: self!

----- Method: SyntaxErrorNotification>>doitFlag (in category 'accessing') -----
doitFlag
^doitFlag!

----- Method: SyntaxErrorNotification>>errorClass (in category 'accessing') -----
errorClass
^inClass!

----- Method: SyntaxErrorNotification>>errorCode (in category 'accessing') -----
errorCode
^code!

----- Method: SyntaxErrorNotification>>errorMessage (in category 'accessing') -----
errorMessage
^errorMessage!

----- Method: SyntaxErrorNotification>>location (in category 'accessing') -----
location
^location!

----- Method: SyntaxErrorNotification>>messageText (in category 'accessing') -----
messageText
^ super messageText
ifNil: [messageText := code]!

----- Method: SyntaxErrorNotification>>setClass:category:code:doitFlag: (in category 'accessing') -----
setClass: aClass category: aCategory code: codeString doitFlag: aBoolean
inClass := aClass.
category := aCategory.
code := codeString.
doitFlag := aBoolean !

----- Method: SyntaxErrorNotification>>setClass:category:code:doitFlag:errorMessage:location: (in category 'accessing') -----
setClass: aClass category: aCategory code: codeString doitFlag: aBoolean errorMessage: errorString location: anInteger
inClass := aClass.
category := aCategory.
code := codeString.
doitFlag := aBoolean.
errorMessage := errorString.
location := anInteger!

----- Method: Exception class>>, (in category 'exceptionSelector') -----
, anotherException
"Create an exception set."

^ExceptionSet new
add: self;
add: anotherException;
yourself!

----- Method: Exception class>>handles: (in category 'exceptionSelector') -----
handles: exception
"Determine whether an exception handler will accept a signaled exception."

^ exception isKindOf: self!

----- Method: Exception class>>signal (in category 'exceptionInstantiator') -----
signal
"Signal the occurrence of an exceptional condition."

^ self new signal!

----- Method: Exception class>>signal: (in category 'exceptionInstantiator') -----
signal: signalerText
"Signal the occurrence of an exceptional condition with a specified textual description."

^ self new signal: signalerText!

----- Method: Exception>>defaultAction (in category 'priv handling') -----
defaultAction
"The default action taken if the exception is signaled."

self subclassResponsibility!

----- Method: Exception>>description (in category 'printing') -----
description
"Return a textual description of the exception."

| desc mt |
desc := self class name asString.
^(mt := self messageText) == nil
ifTrue: [desc]
ifFalse: [desc, ': ', mt]!

----- Method: Exception>>isNested (in category 'handling') -----
isNested
"Determine whether the current exception handler is within the scope of another handler for the same exception."

^ handlerContext nextHandlerContext canHandleSignal: self!

----- Method: Exception>>isResumable (in category 'priv handling') -----
isResumable
"Determine whether an exception is resumable."

^ true!

----- Method: Exception>>messageText (in category 'printing') -----
messageText
"Return an exception's message text."

^messageText!

----- Method: Exception>>messageText: (in category 'signaling') -----
messageText: signalerText
"Set an exception's message text."

messageText := signalerText!

----- Method: Exception>>outer (in category 'handling') -----
outer
"Evaluate the enclosing exception action and return to here instead of signal if it resumes (see #resumeUnchecked:)."

| prevOuterContext |
self isResumable ifTrue: [
prevOuterContext := outerContext.
outerContext := thisContext contextTag.
].
self pass.
!

----- Method: Exception>>pass (in category 'handling') -----
pass
"Yield control to the enclosing exception action for the receiver."

handlerContext nextHandlerContext handleSignal: self!

----- Method: Exception>>printOn: (in category 'printing') -----
printOn: stream

stream nextPutAll: self description!

----- Method: Exception>>privHandlerContext: (in category 'priv handling') -----
privHandlerContext: aContextTag

handlerContext := aContextTag!

----- Method: Exception>>receiver (in category 'printing') -----
receiver

^ self signalerContext receiver!

----- Method: Exception>>resignalAs: (in category 'handling') -----
resignalAs: replacementException
"Signal an alternative exception in place of the receiver."

self resumeUnchecked: replacementException signal!

----- Method: Exception>>resume (in category 'handling') -----
resume
"Return from the message that signaled the receiver."

self resume: nil!

----- Method: Exception>>resume: (in category 'handling') -----
resume: resumptionValue
"Return resumptionValue as the value of the signal message."

self isResumable ifFalse: [IllegalResumeAttempt signal].
self resumeUnchecked: resumptionValue!

----- Method: Exception>>resumeUnchecked: (in category 'handling') -----
resumeUnchecked: resumptionValue
"Return resumptionValue as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer."

| ctxt |
outerContext ifNil: [
signalContext return: resumptionValue
] ifNotNil: [
ctxt := outerContext.
outerContext := ctxt tempAt: 1. "prevOuterContext in #outer"
ctxt return: resumptionValue
].
!

----- Method: Exception>>retry (in category 'handling') -----
retry
"Abort an exception handler and re-evaluate its protected block."

handlerContext restart!

----- Method: Exception>>retryUsing: (in category 'handling') -----
retryUsing: alternativeBlock
"Abort an exception handler and evaluate a new block in place of the handler's protected block."

handlerContext restartWithNewReceiver: alternativeBlock
!

----- Method: Exception>>return (in category 'handling') -----
return
"Return nil as the value of the block protected by the active exception handler."

self return: nil!

----- Method: Exception>>return: (in category 'handling') -----
return: returnValue
"Return the argument as the value of the block protected by the active exception handler."

handlerContext return: returnValue!

----- Method: Exception>>searchFrom: (in category 'handling') -----
searchFrom: aContext
" Set the context where the handler search will start. "

signalContext := aContext contextTag!

----- Method: Exception>>signal (in category 'signaling') -----
signal
"Ask ContextHandlers in the sender chain to handle this signal. The default is to execute and return my defaultAction."

signalContext := thisContext contextTag.
^ thisContext nextHandlerContext handleSignal: self!

----- Method: Exception>>signal: (in category 'signaling') -----
signal: signalerText
"Signal the occurrence of an exceptional condition with a specified textual description."

self messageText: signalerText.
^ self signal!

----- Method: Exception>>signalerContext (in category 'printing') -----
signalerContext
"Find the first sender of signal(:)"

^ signalContext findContextSuchThat: [:ctxt |
(ctxt receiver == self or: [ctxt receiver == self class]) not]!

----- Method: Exception>>tag (in category 'exceptionDescription') -----
tag
"Return an exception's tag value."

^tag == nil
ifTrue: [self messageText]
ifFalse: [tag]!

----- Method: Exception>>tag: (in category 'exceptionBuilder') -----
tag: t
"This message is not specified in the ANSI protocol, but that looks like an oversight because #tag is specified, and the spec states that the signaler may store the tag value."

tag := t!

Exception subclass: #Halt
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Extensions'!

!Halt commentStamp: '<historical>' prior: 0!
Halt is provided to support Object>>halt.!

Halt subclass: #AssertionFailure
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Extensions'!

!AssertionFailure commentStamp: 'gh 5/2/2002 20:29' prior: 0!
AsssertionFailure is the exception signaled from Object>>assert: when the assertion block evaluates to false.!

----- Method: Halt>>defaultAction (in category 'priv handling') -----
defaultAction
"No one has handled this error, but now give them a chance to decide how to debug it. If none handle this either then open debugger (see UnhandedError-defaultAction)"

UnhandledError signalForException: self!

----- Method: Halt>>isResumable (in category 'description') -----
isResumable

^true!

Exception subclass: #IllegalResumeAttempt
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!IllegalResumeAttempt commentStamp: '<historical>' prior: 0!
This class is private to the EHS implementation. An instance of it is signaled whenever an attempt is made to resume from an exception which answers false to #isResumable.!

----- Method: IllegalResumeAttempt>>defaultAction (in category 'comment') -----
defaultAction
"No one has handled this error, but now give them a chance to decide how to debug it. If none handle this either then open debugger (see UnhandedError-defaultAction)"

UnhandledError signalForException: self!

----- Method: IllegalResumeAttempt>>isResumable (in category 'comment') -----
isResumable

^ false!

----- Method: IllegalResumeAttempt>>readMe (in category 'comment') -----
readMe

"Never handle this exception!!"!

Exception subclass: #Notification
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!Notification commentStamp: '<historical>' prior: 0!
A Notification is an indication that something interesting has occurred. If it is not handled, it will pass by without effect.!

Notification subclass: #ExceptionAboutToReturn
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!ExceptionAboutToReturn commentStamp: '<historical>' prior: 0!
This class is private to the EHS implementation. Its use allows for ensured execution to survive code such as:

[self doThis.
^nil]
ensure: [self doThat]

Signaling or handling this exception is not recommended. Not even slightly.!

Notification subclass: #InMidstOfFileinNotification
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: InMidstOfFileinNotification>>defaultAction (in category 'as yet unclassified') -----
defaultAction

self resume: false!

Notification subclass: #MyTestNotification
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Tests'!

----- Method: Notification>>defaultAction (in category 'exceptionDescription') -----
defaultAction
"No action is taken. The value nil is returned as the value of the message that signaled the exception."

^nil!

----- Method: Notification>>isResumable (in category 'exceptionDescription') -----
isResumable
"Answer true. Notification exceptions by default are specified to be resumable."

^true!

Notification subclass: #OutOfScopeNotification
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: OutOfScopeNotification>>defaultAction (in category 'as yet unclassified') -----
defaultAction

self resume: false!

Notification subclass: #ParserRemovedUnusedTemps
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Tests'!

Notification subclass: #PickAFileToWriteNotification
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

Notification subclass: #ProgressNotification
instanceVariableNames: 'amount done extra'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!ProgressNotification commentStamp: '<historical>' prior: 0!
Used to signal progress without requiring a specific receiver to notify. Caller/callee convention could be to simply count the number of signals caught or to pass more substantive information with #signal:.!

----- Method: ProgressNotification class>>signal:extra: (in category 'exceptionInstantiator') -----
signal: signalerText extra: extraParam
"TFEI - Signal the occurrence of an exceptional condition with a specified textual description."

| ex |
ex := self new.
ex extraParam: extraParam.
^ex signal: signalerText!

----- Method: ProgressNotification>>amount (in category 'accessing') -----
amount
^amount!

----- Method: ProgressNotification>>amount: (in category 'accessing') -----
amount: aNumber
amount := aNumber!

----- Method: ProgressNotification>>done (in category 'accessing') -----
done
^done!

----- Method: ProgressNotification>>done: (in category 'accessing') -----
done: aNumber
done := aNumber!

----- Method: ProgressNotification>>extraParam (in category 'accessing') -----
extraParam
^extra!

----- Method: ProgressNotification>>extraParam: (in category 'accessing') -----
extraParam: anObject
extra := anObject!

Notification subclass: #ProgressTargetRequestNotification
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!ProgressTargetRequestNotification commentStamp: '<historical>' prior: 0!
I am used to allow the ComplexProgressIndicator one last chance at finding an appropriate place to display. If I am unhandled, then the cursor location and a default rectangle are used.!

----- Method: ProgressTargetRequestNotification>>defaultAction (in category 'as yet unclassified') -----
defaultAction

self resume: nil!

Notification subclass: #ProjectEntryNotification
instanceVariableNames: 'projectToEnter'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!ProjectEntryNotification commentStamp: '<historical>' prior: 0!
I provide a way to override the style of Project entry (which is buried deep in several different methods). My default is a normal full-screen enter.!

----- Method: ProjectEntryNotification class>>signal: (in category 'as yet unclassified') -----
signal: aProject

| ex |
ex := self new.
ex projectToEnter: aProject.
^ex signal: 'Entering ',aProject printString!

----- Method: ProjectEntryNotification>>defaultAction (in category 'as yet unclassified') -----
defaultAction

self resume: projectToEnter enter!

----- Method: ProjectEntryNotification>>projectToEnter (in category 'as yet unclassified') -----
projectToEnter

^projectToEnter!

----- Method: ProjectEntryNotification>>projectToEnter: (in category 'as yet unclassified') -----
projectToEnter: aProject

projectToEnter := aProject!

Notification subclass: #ProjectPasswordNotification
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: ProjectPasswordNotification>>defaultAction (in category 'as yet unclassified') -----
defaultAction

self resume: ''!

Notification subclass: #ProjectViewOpenNotification
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!ProjectViewOpenNotification commentStamp: '<historical>' prior: 0!
ProjectViewOpenNotification is signalled to determine if a ProjectViewMorph is needed for a newly created project. The default answer is yes.!

----- Method: ProjectViewOpenNotification>>defaultAction (in category 'as yet unclassified') -----
defaultAction

self resume: true!

Notification subclass: #ProvideAnswerNotification
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

Notification subclass: #TimedOut
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!TimedOut commentStamp: 'brp 10/21/2004 17:47' prior: 0!
I am signalled by #duration:timeoutDo: if the receiving block takes too long to execute.

I am signalled by a watchdog process spawned by #duration:timeoutDo: and caught in the same method.

I am not intended to be used elsewhere.!

Notification subclass: #Warning
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!Warning commentStamp: '<historical>' prior: 0!
A Warning is a Notification which by default should be brought to the attention of the user.!

Warning subclass: #Deprecation
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!Deprecation commentStamp: 'dew 5/21/2003 17:46' prior: 0!
This Warning is signalled by methods which are deprecated.

The use of Object>>#deprecatedExplanation: aString and Object>>#deprecated: aBlock explanation: aString is recommended.

Idiom: Imagine I want to deprecate the message #foo.

foo
^ 'foo'

I can replace it with:

foo
self deprecatedExplanation: 'The method #foo was not good. Use Bar>>newFoo instead.'
^ 'foo'

Or, for certain cases such as when #foo implements a primitive, #foo can be renamed to #fooDeprecated.

fooDeprecated
^ <primitive>

foo
^ self deprecated: [self fooDeprecated] explanation: 'The method #foo was not good. Use Bar>>newFoo instead.'
!

----- Method: Warning>>defaultAction (in category 'exceptionDescription') -----
defaultAction
"The user should be notified of the occurrence of an exceptional occurrence and given an option of continuing or aborting the computation. The description of the occurrence should include any text specified as the argument of the #signal: message."
ToolSet
debugContext: thisContext
label: 'Warning'
contents: self messageText, '\\Select Proceed to continue, or close this window to cancel the operation.' withCRs.
self resume.
!

Exception subclass: #ProgressInitiationException
instanceVariableNames: 'workBlock maxVal minVal aPoint progressTitle'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!ProgressInitiationException commentStamp: '<historical>' prior: 0!
I provide a way to alter the behavior of the old-style progress notifier in String. See examples in:

ProgressInitiationException testWithout.
ProgressInitiationException testWith.
!

----- Method: ProgressInitiationException class>>display:at:from:to:during: (in category 'signalling') -----
display: aString at: aPoint from: minVal to: maxVal during: workBlock

^ self new
display: aString at: aPoint from: minVal to: maxVal during: workBlock!

----- Method: ProgressInitiationException class>>testInnermost (in category 'examples and tests') -----
testInnermost

"test the progress code WITHOUT special handling"

^'Now here''s some Real Progress'
displayProgressAt: Sensor cursorPoint
from: 0
to: 10
during: [ :bar |
1 to: 10 do: [ :x |
bar value: x. (Delay forMilliseconds: 500) wait.
x = 5 ifTrue: [1/0]. "just to make life interesting"
].
'done'
].

!

----- Method: ProgressInitiationException class>>testWith (in category 'examples and tests') -----
testWith

"test progress code WITH special handling of progress notifications"

^[ self testWithAdditionalInfo ]
on: ProgressInitiationException
do: [ :ex |
ex sendNotificationsTo: [ :min :max :curr |
Transcript show: min printString,' ',max printString,' ',curr printString; cr
].
].
!

----- Method: ProgressInitiationException class>>testWithAdditionalInfo (in category 'examples and tests') -----
testWithAdditionalInfo

^{'starting'. self testWithout. 'really!!'}!

----- Method: ProgressInitiationException class>>testWithout (in category 'examples and tests') -----
testWithout

"test the progress code WITHOUT special handling"

^[self testInnermost]
on: ZeroDivide
do: [ :ex | ex resume]

!

----- Method: ProgressInitiationException>>defaultAction (in category 'as yet unclassified') -----
defaultAction
Smalltalk isMorphic
ifTrue: [self defaultMorphicAction]
ifFalse: [self defaultMVCAction].
!

----- Method: ProgressInitiationException>>defaultMVCAction (in category 'as yet unclassified') -----
defaultMVCAction

| delta savedArea captionText textFrame barFrame outerFrame result range lastW w |
barFrame := aPoint - (75@10) corner: aPoint + (75@10).
captionText := DisplayText text: progressTitle asText allBold.
captionText
foregroundColor: Color black
backgroundColor: Color white.
textFrame := captionText boundingBox insetBy: -4.
textFrame := textFrame align: textFrame bottomCenter
with: barFrame topCenter + (0@2).
outerFrame := barFrame merge: textFrame.
delta := outerFrame amountToTranslateWithin: Display boundingBox.
barFrame := barFrame translateBy: delta.
textFrame := textFrame translateBy: delta.
outerFrame := outerFrame translateBy: delta.
savedArea := Form fromDisplay: outerFrame.
Display fillBlack: barFrame; fillWhite: (barFrame insetBy: 2).
Display fillBlack: textFrame; fillWhite: (textFrame insetBy: 2).
captionText displayOn: Display at: textFrame topLeft + (4@4).
range := maxVal = minVal ifTrue: [1] ifFalse: [maxVal - minVal]. "Avoid div by 0"
lastW := 0.
[result := workBlock value: "Supply the bar-update block for evaluation in the work block"
[:barVal |
w := ((barFrame width-4) asFloat * ((barVal-minVal) asFloat / range min: 1.0)) asInteger.
w ~= lastW ifTrue: [
Display fillGray: (barFrame topLeft + (2@2) extent: w@16).
lastW := w]]]
ensure: [savedArea displayOn: Display at: outerFrame topLeft].
self resume: result!

----- Method: ProgressInitiationException>>defaultMorphicAction (in category 'as yet unclassified') -----
defaultMorphicAction
| result progress |
progress := SystemProgressMorph label: progressTitle min: minVal max: maxVal.
[
[result := workBlock value: progress] on: ProgressNotification do:[:ex|
ex extraParam isString ifTrue:[
SystemProgressMorph uniqueInstance labelAt: progress put: ex extraParam.
].
ex resume.
].
] ensure: [SystemProgressMorph close: progress].
self resume: result!

----- Method: ProgressInitiationException>>display:at:from:to:during: (in category 'as yet unclassified') -----
display: argString at: argPoint from: argMinVal to: argMaxVal during: argWorkBlock

progressTitle := argString.
aPoint := argPoint.
minVal := argMinVal.
maxVal := argMaxVal.
workBlock := argWorkBlock.
^self signal!

----- Method: ProgressInitiationException>>isResumable (in category 'as yet unclassified') -----
isResumable

^true!

----- Method: ProgressInitiationException>>sendNotificationsTo: (in category 'as yet unclassified') -----
sendNotificationsTo: aNewBlock

self resume: (
workBlock value: [ :barVal |
aNewBlock value: minVal value: maxVal value: barVal
]
)
!

Exception subclass: #UnhandledError
instanceVariableNames: 'exception'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

----- Method: UnhandledError class>>signalForException: (in category 'as yet unclassified') -----
signalForException: anError

^ self new
exception: anError;
signal!

----- Method: UnhandledError>>defaultAction (in category 'priv handling') -----
defaultAction
"The current computation is terminated. The cause of the error should be logged or reported to the user. If the program is operating in an interactive debugging environment the computation should be suspended and the debugger activated."
^ToolSet debugError: exception.!

----- Method: UnhandledError>>exception (in category 'as yet unclassified') -----
exception

^ exception!

----- Method: UnhandledError>>exception: (in category 'as yet unclassified') -----
exception: anError

exception := anError!

----- Method: UnhandledError>>isResumable (in category 'priv handling') -----
isResumable

^ false!

Object subclass: #ExceptionSet
instanceVariableNames: 'exceptions'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Kernel'!

!ExceptionSet commentStamp: '<historical>' prior: 0!
An ExceptionSet is a grouping of exception handlers which acts as a single handler. Within the group, the most recently added handler will be the last handler found during a handler search (in the case where more than one handler in the group is capable of handling a given exception). !

----- Method: ExceptionSet>>, (in category 'exceptionSelector') -----
, anException
"Return an exception set that contains the receiver and the argument exception. This is commonly used to specify a set of exception selectors for an exception handler."

self add: anException.
^self!

----- Method: ExceptionSet>>add: (in category 'private') -----
add: anException

exceptions add: anException!

----- Method: ExceptionSet>>handles: (in category 'exceptionSelector') -----
handles: anException
"Determine whether an exception handler will accept a signaled exception."

exceptions do:
[:ex |
(ex handles: anException)
ifTrue: [^true]].
^false!

----- Method: ExceptionSet>>initialize (in category 'private') -----
initialize

exceptions := OrderedCollection new!

Object subclass: #ExceptionTester
instanceVariableNames: 'log suiteLog iterationsBeforeTimeout'
classVariableNames: ''
poolDictionaries: ''
category: 'Exceptions-Tests'!

----- Method: ExceptionTester>>basicANSISignaledExceptionTestSelectors (in category 'accessing') -----
basicANSISignaledExceptionTestSelectors

^#( simpleIsNestedTest simpleOuterTest doubleOuterTest doubleOuterPassTest doublePassOuterTest simplePassTest simpleResignalAsTest simpleResumeTest simpleRetryTest simpleRetryUsingTest simpleReturnTest)!

----- Method: ExceptionTester>>basicTestSelectors (in category 'accessing') -----
basicTestSelectors
^ #(#simpleEnsureTest #simpleEnsureTestWithNotification #simpleEnsureTestWithUparrow #simpleEnsureTestWithError #signalFromHandlerActionTest #resumableFallOffTheEndHandler #nonResumableFallOffTheEndHandler #doubleResumeTest #simpleTimeoutWithZeroDurationTest #simpleTimeoutTest simpleNoTimeoutTest)!

----- Method: ExceptionTester>>clearLog (in category 'logging') -----
clearLog

log := nil!

----- Method: ExceptionTester>>contents (in category 'logging') -----
contents

^( self log
inject: (WriteStream on: (String new: 80))
into:
[:result :item |
result
cr;
nextPutAll: item;
yourself] ) contents!

----- Method: ExceptionTester>>doSomething (in category 'pseudo actions') -----
doSomething

self log: self doSomethingString!

----- Method: ExceptionTester>>doSomethingElse (in category 'pseudo actions') -----
doSomethingElse

self log: self doSomethingElseString!

----- Method: ExceptionTester>>doSomethingElseString (in category 'accessing') -----
doSomethingElseString

^'Do something else.'!

----- Method: ExceptionTester>>doSomethingExceptional (in category 'pseudo actions') -----
doSomethingExceptional

self log: self doSomethingExceptionalString!

----- Method: ExceptionTester>>doSomethingExceptionalString (in category 'accessing') -----
doSomethingExceptionalString

^'Do something exceptional.'!

----- Method: ExceptionTester>>doSomethingString (in category 'accessing') -----
doSomethingString

^'Do something.'!

----- Method: ExceptionTester>>doYetAnotherThing (in category 'pseudo actions') -----
doYetAnotherThing

self log: self doYetAnotherThingString!

----- Method: ExceptionTester>>doYetAnotherThingString (in category 'accessing') -----
doYetAnotherThingString

^'Do yet another thing.'!

----- Method: ExceptionTester>>doubleOuterPassTest (in category 'signaledException tests') -----
doubleOuterPassTest
"uses #resume"

[[[self doSomething.
MyTestNotification signal.
self doSomethingExceptional]
on: MyTestNotification
do: [:ex | ex outer.
self doSomethingElse]]
on: MyTestNotification
do: [:ex | ex pass.
self doSomethingExceptional]]
on: MyTestNotification
do: [:ex | self doYetAnotherThing. ex resume]!

----- Method: ExceptionTester>>doubleOuterPassTestResults (in category 'signaledException results') -----
doubleOuterPassTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
add: self doSomethingElseString;
yourself!

----- Method: ExceptionTester>>doubleOuterTest (in category 'signaledException tests') -----
doubleOuterTest
"uses #resume"

[[[self doSomething.
MyTestNotification signal.
self doSomethingExceptional]
on: MyTestNotification
do: [:ex | ex outer.
self doSomethingExceptional]]
on: MyTestNotification
do: [:ex | ex outer.
self doSomethingElse]]
on: MyTestNotification
do: [:ex | self doYetAnotherThing. ex resume]!

----- Method: ExceptionTester>>doublePassOuterTest (in category 'signaledException tests') -----
doublePassOuterTest
"uses #resume"

[[[self doSomething.
MyTestNotification signal.
self doSomethingExceptional]
on: MyTestNotification
do: [:ex | ex pass.
self doSomethingExceptional]]
on: MyTestNotification
do: [:ex | ex outer.
self doSomethingElse]]
on: MyTestNotification
do: [:ex | self doYetAnotherThing. ex resume]!

----- Method: ExceptionTester>>doublePassOuterTestResults (in category 'signaledException results') -----
doublePassOuterTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
add: self doSomethingElseString;
yourself!

----- Method: ExceptionTester>>doubleResumeTest (in category 'tests') -----
doubleResumeTest

[self doSomething.
MyResumableTestError signal.
self doSomethingElse.
MyResumableTestError signal.
self doYetAnotherThing]
on: MyResumableTestError
do: [:ex | ex resume].!

----- Method: ExceptionTester>>doubleResumeTestResults (in category 'results') -----
doubleResumeTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doSomethingElseString;
add: self doYetAnotherThingString;
yourself!

----- Method: ExceptionTester>>iterationsBeforeTimeout (in category 'accessing') -----
iterationsBeforeTimeout

^ iterationsBeforeTimeout!

----- Method: ExceptionTester>>iterationsBeforeTimeout: (in category 'accessing') -----
iterationsBeforeTimeout: anInteger

iterationsBeforeTimeout := anInteger!

----- Method: ExceptionTester>>log (in category 'accessing') -----
log

log == nil
ifTrue: [log := OrderedCollection new].
^log!

----- Method: ExceptionTester>>log: (in category 'logging') -----
log: aString

self log add: aString!

----- Method: ExceptionTester>>logTest: (in category 'logging') -----
logTest: aSelector

self suiteLog add: aSelector!

----- Method: ExceptionTester>>logTestResult: (in category 'logging') -----
logTestResult: aString

| index |
index := self suiteLog size.
self suiteLog
at: index
put: ((self suiteLog at: index), ' ', aString)!

----- Method: ExceptionTester>>methodWithError (in category 'pseudo actions') -----
methodWithError

MyTestError signal: self testString!

----- Method: ExceptionTester>>methodWithNotification (in category 'pseudo actions') -----
methodWithNotification

MyTestNotification signal: self testString!

----- Method: ExceptionTester>>nonResumableFallOffTheEndHandler (in category 'tests') -----
nonResumableFallOffTheEndHandler

[self doSomething.
MyTestError signal.
self doSomethingElse]
on: MyTestError
do: [:ex | self doSomethingExceptional].
self doYetAnotherThing!

----- Method: ExceptionTester>>nonResumableFallOffTheEndHandlerResults (in category 'results') -----
nonResumableFallOffTheEndHandlerResults

^OrderedCollection new
add: self doSomethingString;
add: self doSomethingExceptionalString;
add: self doYetAnotherThingString;
yourself!

----- Method: ExceptionTester>>resumableFallOffTheEndHandler (in category 'tests') -----
resumableFallOffTheEndHandler

[self doSomething.
MyTestNotification signal.
self doSomethingElse]
on: MyTestNotification
do: [:ex | self doSomethingExceptional].
self doYetAnotherThing!

----- Method: ExceptionTester>>resumableFallOffTheEndHandlerResults (in category 'results') -----
resumableFallOffTheEndHandlerResults

^OrderedCollection new
add: self doSomethingString;
add: self doSomethingExceptionalString;
add: self doYetAnotherThingString;
yourself!

----- Method: ExceptionTester>>runAllTests (in category 'suites') -----
runAllTests
"ExceptionTester new runAllTests"

self
runBasicTests;
runBasicANSISignaledExceptionTests!

----- Method: ExceptionTester>>runBasicANSISignaledExceptionTests (in category 'suites') -----
runBasicANSISignaledExceptionTests

self basicANSISignaledExceptionTestSelectors
do:
[:eachTestSelector |
self runTest: eachTestSelector]!

----- Method: ExceptionTester>>runBasicTests (in category 'suites') -----
runBasicTests

self basicTestSelectors
do:
[:eachTestSelector |
self runTest: eachTestSelector]!

----- Method: ExceptionTester>>runTest: (in category 'testing') -----
runTest: aSelector

| actualResult expectedResult |
[ self
logTest: aSelector;
clearLog;
perform: aSelector ]
on: MyTestError do:
[ :ex | self log: 'Unhandled Exception'.
ex return: nil ].

actualResult := self log.
expectedResult := self perform: (aSelector, #Results) asSymbol.

actualResult = expectedResult
ifTrue: [self logTestResult: 'succeeded']
ifFalse: [self logTestResult: 'failed' ].
!

----- Method: ExceptionTester>>signalFromHandlerActionTest (in category 'tests') -----
signalFromHandlerActionTest

[self doSomething.
MyTestError signal.
self doSomethingElse]
on: MyTestError
do:
[self doYetAnotherThing.
MyTestError signal]!

----- Method: ExceptionTester>>signalFromHandlerActionTestResults (in category 'results') -----
signalFromHandlerActionTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
add: 'Unhandled Exception';
yourself!

----- Method: ExceptionTester>>simpleEnsureTest (in category 'tests') -----
simpleEnsureTest

[self doSomething.
self doSomethingElse]
ensure:
[self doYetAnotherThing].
!

----- Method: ExceptionTester>>simpleEnsureTestResults (in category 'results') -----
simpleEnsureTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doSomethingElseString;
add: self doYetAnotherThingString;
yourself!

----- Method: ExceptionTester>>simpleEnsureTestWithError (in category 'tests') -----
simpleEnsureTestWithError

[self doSomething.
MyTestError signal.
self doSomethingElse]
ensure:
[self doYetAnotherThing].
!

----- Method: ExceptionTester>>simpleEnsureTestWithErrorResults (in category 'results') -----
simpleEnsureTestWithErrorResults

^OrderedCollection new
add: self doSomethingString;
add: 'Unhandled Exception';
add: self doYetAnotherThingString;
yourself!

----- Method: ExceptionTester>>simpleEnsureTestWithNotification (in category 'tests') -----
simpleEnsureTestWithNotification

[self doSomething.
self methodWithNotification.
self doSomethingElse]
ensure:
[self doYetAnotherThing].
!

----- Method: ExceptionTester>>simpleEnsureTestWithNotificationResults (in category 'results') -----
simpleEnsureTestWithNotificationResults

^OrderedCollection new
add: self doSomethingString;
add: self doSomethingElseString;
add: self doYetAnotherThingString;
yourself!

----- Method: ExceptionTester>>simpleEnsureTestWithUparrow (in category 'tests') -----
simpleEnsureTestWithUparrow

[self doSomething.
true ifTrue: [^nil].
self doSomethingElse]
ensure:
[self doYetAnotherThing].
!

----- Method: ExceptionTester>>simpleEnsureTestWithUparrowResults (in category 'results') -----
simpleEnsureTestWithUparrowResults

^OrderedCollection new
add: self doSomethingString;
" add: self doSomethingElseString;"
add: self doYetAnotherThingString;
yourself!

----- Method: ExceptionTester>>simpleIsNestedTest (in category 'signaledException tests') -----
simpleIsNestedTest
"uses resignalAs:"

[self doSomething.
MyTestError signal.
self doSomethingElse]
on: MyTestError
do:
[:ex |
ex isNested "expecting to detect handler in #runTest:"
ifTrue:
[self doYetAnotherThing.
ex resignalAs: MyTestNotification new]]!

----- Method: ExceptionTester>>simpleIsNestedTestResults (in category 'signaledException results') -----
simpleIsNestedTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
add: self doSomethingElseString;
yourself!

----- Method: ExceptionTester>>simpleNoTimeoutTest (in category 'tests') -----
simpleNoTimeoutTest

[ self doSomething ]
valueWithin: 1 day onTimeout:
[ self doSomethingElse ].
!

----- Method: ExceptionTester>>simpleNoTimeoutTestResults (in category 'results') -----
simpleNoTimeoutTestResults

^OrderedCollection new
add: self doSomethingString;
yourself!

----- Method: ExceptionTester>>simpleOuterTest (in category 'signaledException tests') -----
simpleOuterTest
"uses #resume"

[[self doSomething.
MyTestNotification signal.
"self doSomethingElse"
self doSomethingExceptional]
on: MyTestNotification
do: [:ex | ex outer. self doSomethingElse]]
on: MyTestNotification
do: [:ex | self doYetAnotherThing. ex resume]!

----- Method: ExceptionTester>>simpleOuterTestResults (in category 'signaledException results') -----
simpleOuterTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
add: self doSomethingElseString;
yourself!

----- Method: ExceptionTester>>simplePassTest (in category 'signaledException tests') -----
simplePassTest

[self doSomething.
MyTestError signal.
self doSomethingElse]
on: MyTestError
do:
[:ex |
self doYetAnotherThing.
ex pass "expecting handler in #runTest:"]!

----- Method: ExceptionTester>>simplePassTestResults (in category 'signaledException results') -----
simplePassTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
add: 'Unhandled Exception';
yourself!

----- Method: ExceptionTester>>simpleResignalAsTest (in category 'signaledException tests') -----
simpleResignalAsTest
"ExceptionTester new simpleResignalAsTest"

[self doSomething.
MyTestNotification signal.
self doSomethingElse]
on: MyTestNotification
do:
[:ex | ex resignalAs: MyTestError new]!

----- Method: ExceptionTester>>simpleResignalAsTestResults (in category 'signaledException results') -----
simpleResignalAsTestResults

^OrderedCollection new
add: self doSomethingString;
add: 'Unhandled Exception';
yourself!

----- Method: ExceptionTester>>simpleResumeTest (in category 'signaledException tests') -----
simpleResumeTest

"see if we can resume twice"

| it |
[self doSomething.
it := MyResumableTestError signal.
it = 3 ifTrue: [self doSomethingElse].
it := MyResumableTestError signal.
it = 3 ifTrue: [self doSomethingElse].
]
on: MyResumableTestError
do:
[:ex |
self doYetAnotherThing.
ex resume: 3]!

----- Method: ExceptionTester>>simpleResumeTestResults (in category 'signaledException results') -----
simpleResumeTestResults

"see if we can resume twice"

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
add: self doSomethingElseString;
add: self doYetAnotherThingString;
add: self doSomethingElseString;
yourself!

----- Method: ExceptionTester>>simpleRetryTest (in category 'signaledException tests') -----
simpleRetryTest

| theMeaningOfLife |
theMeaningOfLife := nil.
[self doSomething.
theMeaningOfLife == nil
ifTrue: [MyTestError signal]
ifFalse: [self doSomethingElse]]
on: MyTestError
do:
[:ex |
theMeaningOfLife := 42.
self doYetAnotherThing.
ex retry]!

----- Method: ExceptionTester>>simpleRetryTestResults (in category 'signaledException results') -----
simpleRetryTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
add: self doSomethingString;
add: self doSomethingElseString;
yourself!

----- Method: ExceptionTester>>simpleRetryUsingTest (in category 'signaledException tests') -----
simpleRetryUsingTest

[self doSomething.
MyTestError signal.
self doSomethingElse]
on: MyTestError
do:
[:ex | ex retryUsing: [self doYetAnotherThing]]!

----- Method: ExceptionTester>>simpleRetryUsingTestResults (in category 'signaledException results') -----
simpleRetryUsingTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
yourself!

----- Method: ExceptionTester>>simpleReturnTest (in category 'signaledException tests') -----
simpleReturnTest

| it |
it :=
[self doSomething.
MyTestError signal.
self doSomethingElse]
on: MyTestError
do: [:ex | ex return: 3].
it = 3 ifTrue: [self doYetAnotherThing]!

----- Method: ExceptionTester>>simpleReturnTestResults (in category 'signaledException results') -----
simpleReturnTestResults

^OrderedCollection new
add: self doSomethingString;
add: self doYetAnotherThingString;
yourself!

----- Method: ExceptionTester>>simpleTimeoutTest (in category 'tests') -----
simpleTimeoutTest

| n |
[1 to: 1000000 do: [ :i | n := i. self doSomething ] ]
valueWithin: 50 milliSeconds onTimeout:
[ self iterationsBeforeTimeout: n.
self doSomethingElse ]!

----- Method: ExceptionTester>>simpleTimeoutTestResults (in category 'results') -----
simpleTimeoutTestResults

| things |
things := OrderedCollection new: self iterationsBeforeTimeout.

self iterationsBeforeTimeout timesRepeat: [ things add: self doSomethingString ].
things add: self doSomethingElseString.

^ things!

----- Method: ExceptionTester>>simpleTimeoutWithZeroDurationTest (in category 'tests') -----
simpleTimeoutWithZeroDurationTest

[ self doSomething ]
valueWithin: 0 seconds onTimeout:
[ self doSomethingElse ].
!

----- Method: ExceptionTester>>simpleTimeoutWithZeroDurationTestResults (in category 'results') -----
simpleTimeoutWithZeroDurationTestResults

^OrderedCollection new
add: self doSomethingElseString;
yourself!

----- Method: ExceptionTester>>suiteLog (in category 'accessing') -----
suiteLog

suiteLog == nil
ifTrue: [suiteLog := OrderedCollection new].
^suiteLog!

----- Method: ExceptionTester>>testString (in category 'accessing') -----
testString

^'This is only a test.'!

----- Method: ExceptionTester>>warningTest (in category 'tests') -----
warningTest

self log: 'About to signal warning.'.
Warning signal: 'Ouch'.
self log: 'Warning signal handled and resumed.'!