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

commits at source.squeak.org commits at source.squeak.org
Sun Sep 6 00:32:08 UTC 2009


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 at 10) corner: aPoint + (75 at 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 at 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 at 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 at 2) extent: w at 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.'!




More information about the Squeak-dev mailing list