expectvalue %String
run
Object _newKernelSubclass: 'TestResource'
  instVarNames: #( name description)
  classVars: #()
  classInstVars: #( current)
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
Object _newKernelSubclass: 'TestCase'
  instVarNames: #( testSelector)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
Object _newKernelSubclass: 'TestResult'
  instVarNames: #( failures errors passed)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
Object _newKernelSubclass: 'TestSuite'
  instVarNames: #( tests resources name)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
category: 'For Documentation Installation only'
classmethod: TestResource
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'This is the abstract superclass for test resources.
It is provided by the SUnit framework.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: TestCase
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'This is the abstract superclass for tests.
It is provided by the SUnit framework.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: TestResult
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'This class is internal to the SUnit test framework.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: TestSuite
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'This class is internal to the SUnit test framework.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'Accessing'
classmethod: TestCase
allTestSelectors

	^self sunitAllSelectors select: [:each | 'test*' sunitMatch: each]
%
category: 'Building Suites'
classmethod: TestCase
buildSuite
	| suite |
	^self isAbstract
		ifTrue: 
			[suite := self suiteClass named: self name asString.
			self allSubclasses 
				do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]].
			suite]
		ifFalse: [self buildSuiteFromSelectors]
%
category: 'Building Suites'
classmethod: TestCase
buildSuiteFromAllSelectors

	^self buildSuiteFromMethods: self allTestSelectors
%
category: 'Building Suites'
classmethod: TestCase
buildSuiteFromLocalSelectors

	^self buildSuiteFromMethods: self testSelectors
%
category: 'Building Suites'
classmethod: TestCase
buildSuiteFromMethods: testMethods

	^testMethods
		inject: (self suiteClass named: self name asString)
		into: [:suite :selector |
			suite
				addTest: (self selector: selector);
				yourself]
%
category: 'Building Suites'
classmethod: TestCase
buildSuiteFromSelectors

	^self shouldInheritSelectors
		ifTrue: [self buildSuiteFromAllSelectors]
		ifFalse: [self buildSuiteFromLocalSelectors]
%
category: 'other'
classmethod: TestCase
COMMENT

"A TestCase is a Command representing the future running of a test case. 
Create one with the class method #selector: aSymbol, passing the name 
of the method to be run when the test case runs.

When you discover a new fixture, subclass TestCase, declare instance 
variables for the objects in the fixture, override #setUp to initialize the 
variables, and possibly override# tearDown to deallocate any external 
resources allocated in #setUp.

When you are writing a test case method, send #assert: aBoolean when 
you want to check for an expected value. For example, you might say 
'self assert: socket isOpen' to test whether or not a socket is open at 
a point in a test."
%
category: 'Instance Creation'
classmethod: TestCase
debug: aSymbol

	^(self selector: aSymbol) debug
%
category: 'Testing'
classmethod: TestCase
isAbstract
	"Override to true if a TestCase subclass is Abstract and should not have
	TestCase instances built from it"

	^self sunitName = #TestCase
%
category: 'Accessing'
classmethod: TestCase
resources

	^#()
%
category: 'Instance Creation'
classmethod: TestCase
run: aSymbol

	^(self selector: aSymbol) run
%
category: 'Instance Creation'
classmethod: TestCase
selector: aSymbol

	^self new setTestSelector: aSymbol
%
category: 'Testing'
classmethod: TestCase
shouldInheritSelectors
	"I should inherit from an Abstract superclass but not from a concrete one by default, 
	unless I have no testSelectors in which case I must be expecting to inherit them from 
	my superclass.  If a test case with selectors wants to inherit selectors from a concrete 
	superclass, override this to true in that subclass."

	^self superclass isAbstract
		_or: [self testSelectors isEmpty]

"$QA Ignore:Sends system method(superclass)$"
%
category: 'Instance Creation'
classmethod: TestCase
suite

	^self buildSuite
%
category: 'Building Suites'
classmethod: TestCase
suiteClass
	^TestSuite
%
category: 'Accessing'
classmethod: TestCase
sunitVersion
	^'3.1'
%
category: 'Accessing'
classmethod: TestCase
testSelectors

	^self sunitSelectors select: [:each | 'test*' sunitMatch: each]
%
category: 'Dependencies'
method: TestCase
addDependentToHierachy: anObject 
	"an empty method. for Composite compability with TestSuite"
%
category: 'Accessing'
method: TestCase
assert: aBoolean

	aBoolean ifFalse: [self signalFailure: 'Assertion failed']
%
category: 'Accessing'
method: TestCase
assert: aBoolean description: aString
	aBoolean ifFalse: [
		self logFailure: aString.
		TestResult failure sunitSignalWith: aString]
%
category: 'Accessing'
method: TestCase
assert: aBoolean description: aString resumable: resumableBoolean 
	| exception |
	aBoolean
		ifFalse: 
			[self logFailure: aString.
			exception := resumableBoolean
						ifTrue: [TestResult resumableFailure]
						ifFalse: [TestResult failure].
			exception sunitSignalWith: aString]
%
category: 'Running'
method: TestCase
debug
	self resources do: [:res | 
		res isAvailable ifFalse: [^res signalInitializationError]
  ].
	[
    (self class selector: testSelector) runCase
  ] sunitEnsure: [
    self resources do: [:each | 
      each reset
    ]
  ]
%
category: 'Running'
method: TestCase
debugAsFailure
	| semaphore |
	semaphore := Semaphore new.
	self resources do: [:res | 
		res isAvailable ifFalse: [^res signalInitializationError]].
	[semaphore wait. self resources do: [:each | each reset]] fork.
	(self class selector: testSelector) runCaseAsFailure: semaphore.
%
category: 'Accessing'
method: TestCase
deny: aBoolean

	self assert: aBoolean not
%
category: 'Accessing'
method: TestCase
deny: aBoolean description: aString
	self assert: aBoolean not description: aString
%
category: 'Accessing'
method: TestCase
deny: aBoolean description: aString resumable: resumableBoolean 
	self
		assert: aBoolean not
		description: aString
		resumable: resumableBoolean
%
category: 'Private'
method: TestCase
executeShould: aBlock inScopeOf: anExceptionalEvent 
	^[aBlock value.
 	false] sunitOn: anExceptionalEvent
		do: [:ex | ex sunitExitWith: true]
%
category: 'Running'
method: TestCase
failureLog
	^SUnitNameResolver defaultLogDevice
%
category: 'Running'
method: TestCase
isLogging
	"By default, we're not logging failures. If you override this in 
	a subclass, make sure that you override #failureLog"
	^false
%
category: 'Running'
method: TestCase
logFailure: aString
	self isLogging ifTrue: [
		self failureLog 
			cr; 
			nextPutAll: aString; 
			flush]
%
category: 'Running'
method: TestCase
openDebuggerOnFailingTestMethod
	"SUnit has halted one step in front of the failing test method. Step over the 'self halt' and 
	 send into 'self perform: testSelector' to see the failure from the beginning"

	self
		halt;
		performTest
%
category: 'Private'
method: TestCase
performTest

	self perform: testSelector sunitAsSymbol
%
category: 'Printing'
method: TestCase
printOn: aStream

	aStream
		nextPutAll: self class printString;
		nextPutAll: '>>#';
		nextPutAll: testSelector
%
category: 'Dependencies'
method: TestCase
removeDependentFromHierachy: anObject 
	"an empty method. for Composite compability with TestSuite"
%
category: 'Accessing'
method: TestCase
resources
	| allResources resourceQueue |
	allResources := Set new.
	resourceQueue := OrderedCollection new.
	resourceQueue addAll: self class resources.
	[resourceQueue isEmpty] whileFalse: [
		| next |
		next := resourceQueue removeFirst.
		allResources add: next.
		resourceQueue addAll: next resources].
	^allResources
%
category: 'Running'
method: TestCase
run
	| result |
	result := TestResult new.
	self run: result.
	^result
%
category: 'Running'
method: TestCase
run: aResult
	aResult runCase: self
%
category: 'Running'
method: TestCase
runCase

	[self setUp.
	self performTest] sunitEnsure: [self tearDown]
%
category: 'Running'
method: TestCase
runCaseAsFailure: aSemaphore
	[self setUp.
	self openDebuggerOnFailingTestMethod] sunitEnsure: [
		self tearDown.
		aSemaphore signal]
%
category: 'Accessing'
method: TestCase
selector
	^testSelector
%
category: 'Private'
method: TestCase
setTestSelector: aSymbol
	testSelector := aSymbol
%
category: 'Running'
method: TestCase
setUp
%
category: 'Accessing'
method: TestCase
should: aBlock
	self assert: aBlock value
%
category: 'Accessing'
method: TestCase
should: aBlock description: aString
	self assert: aBlock value description: aString
%
category: 'Accessing'
method: TestCase
should: aBlock raise: anExceptionalEvent 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
%
category: 'Accessing'
method: TestCase
should: aBlock raise: anExceptionalEvent description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
		description: aString
%
category: 'Accessing'
method: TestCase
shouldnt: aBlock
	self deny: aBlock value
%
category: 'Accessing'
method: TestCase
shouldnt: aBlock description: aString
	self deny: aBlock value description: aString
%
category: 'Accessing'
method: TestCase
shouldnt: aBlock raise: anExceptionalEvent 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
%
category: 'Accessing'
method: TestCase
shouldnt: aBlock raise: anExceptionalEvent description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not 
		description: aString
%
category: 'Accessing'
method: TestCase
signalFailure: aString
	TestResult failure sunitSignalWith: aString
%
category: 'Running'
method: TestCase
tearDown
%
category: 'Accessing'
classmethod: TestResource
current
	"Use SesionTemps to avoid potential Segment permission problems"
	
	| cur |
	cur := SessionTemps current at: self sessionTempsName otherwise: nil.
	cur == nil
		ifTrue: [
			cur := self new.
			self current: cur].
	^cur
%
category: 'Accessing'
classmethod: TestResource
current: aTestResource

	SessionTemps current at: self sessionTempsName put: aTestResource
%
category: 'Private'
classMethod: TestResource
sessionTempsName

	^('Current_', self thisClass name) asSymbol
%
category: 'Testing'
classmethod: TestResource
isAbstract
	"Override to true if a TestResource subclass is Abstract and should not have
	TestCase instances built from it"

	^self name = #TestResource
%
category: 'Testing'
classmethod: TestResource
isAvailable
	^self current ~~ nil _and: [self current isAvailable]
%
category: 'Testing'
classmethod: TestResource
isUnavailable

	^self isAvailable not
%
category: 'Creation'
classmethod: TestResource
new

	^self basicNew initialize
%
category: 'Creation'
classmethod: TestResource
reset

	current ~~ nil ifTrue: [
		[current tearDown] ensure: [
			current := nil]]
%
category: 'Accessing'
classmethod: TestResource
resources
	^#()
%
category: 'Creation'
classmethod: TestResource
signalInitializationError
	^TestResult signalErrorWith: 'Resource ' , self name , ' could not be initialized'
%
category: 'Accessing'
method: TestResource
description

	description == nil
		ifTrue: [^''].

	^description.
%
category: 'Accessing'
method: TestResource
description: aString

	description := aString.
%
category: 'Init / Release'
method: TestResource
initialize
	self setUp.
%
category: 'Testing'
method: TestResource
isAvailable
	"override to provide information on the
	readiness of the resource"
	
	^true
%
category: 'Testing'
method: TestResource
isUnavailable
	"override to provide information on the
	readiness of the resource"
	
	^self isAvailable not
%
category: 'Accessing'
method: TestResource
name

	name == nil
		ifTrue: [^self printString].

	^name.
%
category: 'Accessing'
method: TestResource
name: aString

	name := aString.
%
category: 'Printing'
method: TestResource
printOn: aStream

	aStream nextPutAll: self class printString
%
category: 'Accessing'
method: TestResource
resources
	^self class resources.
%
category: 'Running'
method: TestResource
setUp
	"Does nothing. Subclasses should override this
	to initialize their resource"
%
category: 'Running'
method: TestResource
signalInitializationError
	^self class signalInitializationError
%
category: 'Running'
method: TestResource
tearDown
	"Does nothing. Subclasses should override this
	to tear down their resource"
%
category: 'other'
classmethod: TestResult
COMMENT

"This is a Collecting Parameter for the running of a bunch of tests. 
TestResult is an interesting object to subclass or substitute. 
#runCase: is the external protocol you need to reproduce. 
Kent has seen TestResults that recorded coverage information 
and that sent email when they were done."
%
category: 'Exceptions'
classmethod: TestResult
error
	^self exError
%
category: 'Exceptions'
classmethod: TestResult
exError
	^SUnitNameResolver errorObject
%
category: 'Exceptions'
classmethod: TestResult
failure
	^TestFailure
%
category: 'Init / Release'
classmethod: TestResult
new
	^self basicNew initialize
%
category: 'Exceptions'
classmethod: TestResult
resumableFailure
	^ResumableTestFailure
%
category: 'Exceptions'
classmethod: TestResult
signalErrorWith: aString 
	self error sunitSignalWith: aString
%
category: 'Exceptions'
classmethod: TestResult
signalFailureWith: aString 
	self failure sunitSignalWith: aString
%
category: 'Accessing'
method: TestResult
correctCount
	"depreciated - use #passedCount"

	^self passedCount
%
category: 'Accessing'
method: TestResult
defects
	^OrderedCollection new
		addAll: self errors;
		addAll: self failures; yourself
%
category: 'Accessing'
method: TestResult
errorCount

	^self errors size
%
category: 'Accessing'
method: TestResult
errors

	errors == nil
		ifTrue: [errors := OrderedCollection new].
	^errors
%
category: 'Accessing'
method: TestResult
failureCount

	^self failures size
%
category: 'Accessing'
method: TestResult
failures
	failures == nil
		ifTrue: [failures := Set new].
	^failures
%
category: 'Testing'
method: TestResult
hasErrors

	^self errors size > 0
%
category: 'Testing'
method: TestResult
hasFailures

	^self failures size > 0
%
category: 'Testing'
method: TestResult
hasPassed

	^self hasErrors not _and: [self hasFailures not]
%
category: 'Init / Release'
method: TestResult
initialize
%
category: 'Testing'
method: TestResult
isError: aTestCase

	^self errors includes: aTestCase
%
category: 'Testing'
method: TestResult
isFailure: aTestCase
	^self failures includes: aTestCase
%
category: 'Testing'
method: TestResult
isPassed: aTestCase

	^self passed includes: aTestCase
%
category: 'Accessing'
method: TestResult
passed

	passed == nil
		ifTrue: [passed := OrderedCollection new].

	^passed
%
category: 'Accessing'
method: TestResult
passedCount

	^self passed size
%
category: 'Printing'
method: TestResult
printOn: aStream

	aStream
		nextPutAll: self runCount printString;
		nextPutAll: ' run, ';
		nextPutAll: self correctCount printString;
		nextPutAll: ' passed, ';
		nextPutAll: self failureCount printString;
		nextPutAll: ' failed, ';
		nextPutAll: self errorCount printString;
		nextPutAll: ' error'.

	self errorCount ~~ 1
		ifTrue: [aStream nextPut: $s]
%
category: 'Running'
method: TestResult
runCase: aTestCase

	[
		[
			aTestCase runCase.
			self passed add: aTestCase.
		] sunitOn: self class failure do: [:signal |
			self failures add: aTestCase.
			^self.
		].
	] sunitOn: self class error do: [:signal |
		self errors add: aTestCase.
		^self.
	].
%
category: 'Accessing'
method: TestResult
runCount

	^self passedCount + self failureCount + self errorCount
%
category: 'Accessing'
method: TestResult
tests

	^(OrderedCollection new: self runCount)
		addAll: self passed;
		addAll: self errors;
		addAll: self failures;
		yourself
%
category: 'other'
classmethod: TestSuite
COMMENT

"This is a Composite of Tests, either TestCases or other TestSuites. 
The common protocol is #run: aTestResult and the dependencies protocol"
%
category: 'Creation'
classmethod: TestSuite
named: aString

	^self new
		name: aString;
		yourself
%
category: 'Dependencies'
method: TestSuite
addDependentToHierachy: anObject
	self sunitAddDependent: anObject.
	self tests do: [ :each | each addDependentToHierachy: anObject]
%
category: 'Accessing'
method: TestSuite
addTest: aTest
	self tests add: aTest
%
category: 'Accessing'
method: TestSuite
addTests: aCollection 
	aCollection do: [:eachTest | self addTest: eachTest]
%
category: 'Accessing'
method: TestSuite
defaultResources
	^self tests 
		inject: Set new
		into: [:coll :testCase | 
			coll
				addAll: testCase resources;
				yourself]
%
category: 'Accessing'
method: TestSuite
name

	^name
%
category: 'Accessing'
method: TestSuite
name: aString

	name := aString
%
category: 'Dependencies'
method: TestSuite
removeDependentFromHierachy: anObject
	self sunitRemoveDependent: anObject.
	self tests do: [ :each | each removeDependentFromHierachy: anObject]
%
category: 'Accessing'
method: TestSuite
resources
	resources == nil ifTrue: [resources := self defaultResources].
	^resources
%
category: 'Accessing'
method: TestSuite
resources: anObject
	resources := anObject
%
category: 'Running'
method: TestSuite
run
	| result |
 	result := TestResult new.
	self resources do: [ :res |
		res isAvailable ifFalse: [^res signalInitializationError]].
	[self run: result] sunitEnsure: [self resources do: [:each | each reset]].
	^result
%
category: 'Running'
method: TestSuite
run: aResult 
	self tests do: [:each | 
		self sunitChanged: each.
		each run: aResult]
%
category: 'Accessing'
method: TestSuite
tests
	tests == nil ifTrue: [tests := OrderedCollection new].
	^tests
%
