[FIX] Remove SUnit litter

Henrik Gedenryd h.gedenryd at open.ac.uk
Mon Dec 17 09:25:09 UTC 2001


Modify SUnit so as not to litter compatibility methods throughout the base
classes (e.g. Symbol>>sunitAsClass, Class>>sunitName,
BlockContext>>sunitEnsure) when there is no need for it, neither any obvious
advantage in doing so.

When needed, methods were placed on the class side of TestCase, this could
be prettier by creating e.g. a class SUnit and placing them there.

This is divided into two change sets, with changes that are and are not
specific to Squeak, respectively.

If someone would want to feed this back to Camp Smalltalk, feel free to do
so, I don't know who is in charge of this.

Henrik

-------------- next part --------------
'From Squeak3.2alpha of 1 November 2001 [latest update: #4599] on 16 December 2001 at 3:50:28 pm'!
"Change Set:		sunitrefactorings
Date:			16 December 2001
Author:			Henrik Gedenryd

Modify SUnit so as not to litter compatibility methods throughout the base classes (e.g. Symbol>>sunitAsClass) when there is no need for it, neither any obvious advantage in doing so. 

When needed, methods were placed on the class side of TestCase, this could be prettier by creating e.g. a class SUnit and placing them there.

This is divided into two change sets, with changes that are and are not specific to Squeak, respectively."!


!TestCase class methodsFor: 'Accessing' stamp: 'hg 12/16/2001 15:09'!
match: aString with: pattern

	^pattern match: aString! !

!TestCase class methodsFor: 'Accessing' stamp: 'hg 12/16/2001 14:57'!
sunitAllSelectors

        ^self allSelectors asSortedCollection asOrderedCollection! !

!TestCase class methodsFor: 'Accessing' stamp: 'hg 12/16/2001 15:15'!
sunitSelectors

        ^self selectors asSortedCollection asOrderedCollection! !

!TestCase class methodsFor: 'exception wrappers' stamp: 'hg 12/16/2001 15:03'!
evaluate: aBlock andEnsure: ensureBlock

        ^aBlock ensure: ensureBlock! !

!TestCase class methodsFor: 'exception wrappers' stamp: 'hg 12/16/2001 15:11'!
evaluate: aBlock on: anException do: aHandlerBlock

        ^aBlock on: anException do: aHandlerBlock! !

!TestCase class methodsFor: 'exception wrappers' stamp: 'hg 12/16/2001 15:16'!
exit: signal with: aValue

	^signal return: aValue! !

!TestCase class methodsFor: 'exception wrappers' stamp: 'hg 12/16/2001 15:16'!
signal: signal with: aValue

	^signal signal: aValue! !


!TestSuite methodsFor: 'Dependencies' stamp: 'hg 12/16/2001 14:56'!
sunitAddDependent: anObject

        self addDependent: anObject! !

!TestSuite methodsFor: 'Dependencies' stamp: 'hg 12/16/2001 15:14'!
sunitRemoveDependent: anObject

        self removeDependent: anObject! !

!TestSuite methodsFor: 'Running' stamp: 'hg 12/16/2001 15:00'!
sunitChanged: anAspect

        self changed: anAspect! !

TestCase class removeSelector: #sunitEnsure:!
TestCase class removeSelector: #sunitEvaluate:andEnsure:!
Symbol removeSelector: #sunitAsClass!
String removeSelector: #sunitAsSymbol!
String removeSelector: #sunitMatch:!
String removeSelector: #sunitSubStrings!
Exception removeSelector: #sunitExitWith:!
Class removeSelector: #sunitName!
BlockContext removeSelector: #sunitEnsure:!
BlockContext removeSelector: #sunitOn:do:!
Behavior removeSelector: #sunitAllSelectors!
Behavior removeSelector: #sunitSelectors!
Object removeSelector: #sunitAddDependent:!
Object removeSelector: #sunitChanged:!
Object removeSelector: #sunitRemoveDependent:!
-------------- next part --------------
'From Squeak3.2alpha of 1 November 2001 [latest update: #4599] on 16 December 2001 at 3:50:31 pm'!
"Change Set:		sunitrefactorings
Date:			16 December 2001
Author:			Henrik Gedenryd

Modify SUnit so as not to litter compatibility methods throughout the base classes (e.g. Symbol>>sunitAsClass) when there is no need for it, neither any obvious advantage in doing so. 

When needed, methods were placed on the class side of TestCase, this could be prettier by creating e.g. a class SUnit and placing them there.

This is divided into two change sets, with changes that are and are not specific to Squeak, respectively."!


!TestCase methodsFor: 'Accessing' stamp: 'hg 12/16/2001 15:17'!
signalFailure: aString
        
	TestCase signal: TestResult failure with: aString
! !

!TestCase methodsFor: 'Private' stamp: 'hg 12/16/2001 15:12'!
executeShould: aBlock inScopeOf: anExceptionalEvent
	
	TestCase
		evaluate: 
			[TestCase 
			evaluate:[aBlock value]
			on: anExceptionalEvent
			do: [:ex | ^true]]
 		on: TestResult error
		do: [:ex | ^false].
	^false.! !

!TestCase methodsFor: 'Private' stamp: 'hg 12/16/2001 14:59'!
performTest
	self perform: testSelector! !

!TestCase methodsFor: 'Running' stamp: 'hg 12/16/2001 15:05'!
debugUsing: aSymbol 
	self areAllResourcesAvailable ifFalse: [^TestResult signalErrorWith: 'Resource could not be initialized'].
	TestCase 
		evaluate: [(self class selector: testSelector) perform: aSymbol] 
		andEnsure: [self resources do: [:each | each reset]]! !

!TestCase methodsFor: 'Running' stamp: 'hg 12/16/2001 15:04'!
runCase
	self setUp.
	TestCase evaluate: [self performTest] andEnsure: [self tearDown]! !

!TestCase methodsFor: 'Running' stamp: 'hg 12/16/2001 15:05'!
runCaseAsFailure


	self setUp.
	[TestCase 
			evaluate: [self openDebuggerOnFailingTestMethod] 
			andEnsure: [self tearDown]
	] fork! !


!TestCase class methodsFor: 'Accessing' stamp: 'hg 12/16/2001 15:08'!
allTestSelectors
	^self sunitAllSelectors select: [:each | self match: each with: 'test*']! !

!TestCase class methodsFor: 'Accessing' stamp: 'hg 12/16/2001 15:09'!
testSelectors
	^self sunitSelectors select: [:each | self match: each with: 'test*']! !


!TestResult methodsFor: 'Running' stamp: 'hg 12/16/2001 15:19'!
runCase: aTestCase
	| testCasePassed |
	testCasePassed := true.
	TestCase
		evaluate:
			[TestCase
				evaluate: [aTestCase runCase] 
				on: self class failure
				do: [:signal | 
					self failures add: aTestCase.
					testCasePassed := false.
					TestCase exit: signal with: false]]
		on: self class error
		do: [:signal |
			self errors add: aTestCase.
			testCasePassed := false.
			TestCase exit: signal with: false].
	testCasePassed ifTrue: [self passed add: aTestCase]! !


!TestResult class methodsFor: 'Exceptions' stamp: 'hg 12/16/2001 15:17'!
signalErrorWith: aString
        
	TestCase signal: self error with: aString! !

!TestResult class methodsFor: 'Exceptions' stamp: 'hg 12/16/2001 15:17'!
signalFailureWith: aString

	TestCase signal: self failure with: aString! !


!TestRunner methodsFor: 'processing' stamp: 'hg 12/16/2001 15:19'!
runOneTest
	Cursor execute showWhile:
		[testSuite ifNil: 
			[self runWindow.
			^ self displayPassFail: 'No Test Suite Selected'].
		 (testSuite indexOf: $( ) > 0 
			ifTrue:	"Just MethodCalls for the named class"
				[self runWindow.
				result _ (TestViaMethodCall buildSuite: testSuite) run.
				self updateWindow: result]
		     ifFalse:		"Normal subclass of TestCase"
				[self runWindow.
				result _ (self testSuiteClassNamed: testSuite asSymbol) suite run.
				self updateWindow: result]
		]! !

!TestRunner methodsFor: 'processing' stamp: 'hg 12/16/2001 14:59'!
testSuiteClassNamed: testSuiteName

	  ^SUnitNameResolver classNamed: testSuiteName! !


!TestSuite methodsFor: 'Running' stamp: 'hg 12/16/2001 15:03'!
run
	| result |
	result := TestResult new.
	self areAllResourcesAvailable ifFalse: [^TestResult signalErrorWith: 'Resource could not be initialized'].
	TestCase evaluate: [self run: result] andEnsure: [self resources do: [:each | each reset]].
	^result! !



More information about the Squeak-dev mailing list