
expectvalue %String
run
TestCase _newKernelSubclass: 'ResumableTestFailureTestCase'
  instVarNames: #()
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
TestCase _newKernelSubclass: 'SUnitTest'
  instVarNames: #( hasRun hasSetup hasRanOnce)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
TestCase _newKernelSubclass: 'SimpleTestResourceTestCase'
  instVarNames: #( resource)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
TestCase _newKernelSubclass: 'ExampleSetTest'
  instVarNames: #( full empty)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
TestResource _newKernelSubclass: 'SimpleTestResource'
  instVarNames: #( runningState hasRun hasSetup
                    hasRanOnce)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
category: 'For Documentation Installation only'
classmethod: ResumableTestFailureTestCase
installDocumentation

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

txt := (GsDocText new) details:
'This is a sample test.'.
doc documentClassWith: txt.

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

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

txt := (GsDocText new) details:
'This is the abstract superclass for all tests.'.
doc documentClassWith: txt.

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

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

txt := (GsDocText new) details:
'This demonstrates the use of test resources.'.
doc documentClassWith: txt.

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

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

txt := (GsDocText new) details:
'This is a simple example of a test.'.
doc documentClassWith: txt.

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

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

txt := (GsDocText new) details:
'This is an example of a test resource.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'Running'
method: ExampleSetTest
setUp
	empty := Set new.
	full := Set with: 5 with: #abc
%
category: 'Testing'
method: ExampleSetTest
testAdd
	empty add: 5.
	self assert: (empty includes: 5)
%
category: 'Testing'
method: ExampleSetTest
testGrow
	empty addAll: (1 to: 100).
	self assert: empty size == 100
%
category: 'Testing'
method: ExampleSetTest
testIllegal
	self 
		should: [empty at: 5] 
		raise: TestResult error.
	self 
		should: [empty at: 5 put: #abc] 
		raise: TestResult error
%
category: 'Testing'
method: ExampleSetTest
testIncludes
	self assert: (full includes: 5).
	self assert: (full includes: #abc)
%
category: 'Testing'
method: ExampleSetTest
testOccurrences
	self assert: (empty occurrencesOf: 0) == 0.
	self assert: (full occurrencesOf: 5) == 1.
	full add: 5.
	self assert: (full occurrencesOf: 5) == 1
%
category: 'Testing'
method: ExampleSetTest
testRemove
	full remove: 5.
	self assert: (full includes: #abc).
	self deny: (full includes: 5)
%
category: 'other'
method: ResumableTestFailureTestCase
errorTest
	1 zork
%
category: 'other'
method: ResumableTestFailureTestCase
failureLog
	^SUnitNameResolver defaultLogDevice
%
category: 'other'
method: ResumableTestFailureTestCase
failureTest
	self
		assert: false description: 'You should see me' resumable: true; 
		assert: false description: 'You should see me too' resumable: true; 
		assert: false description: 'You should see me last' resumable: false; 
		assert: false description: 'You should not see me' resumable: true
%
category: 'other'
method: ResumableTestFailureTestCase
okTest
	self assert: true
%
category: 'other'
method: ResumableTestFailureTestCase
regularTestFailureTest
	self assert: false description: 'You should see me'
%
category: 'other'
method: ResumableTestFailureTestCase
resumableTestFailureTest
	self
		assert: false description: 'You should see me' resumable: true; 
		assert: false description: 'You should see me too' resumable: true; 
		assert: false description: 'You should see me last' resumable: false; 
		assert: false description: 'You should not see me' resumable: true
%
category: 'other'
method: ResumableTestFailureTestCase
testResumable
	| result suite |
	suite := TestSuite new.
	suite addTest: (self class selector: #errorTest).
	suite addTest: (self class selector: #regularTestFailureTest).
	suite addTest: (self class selector: #resumableTestFailureTest).
	suite addTest: (self class selector: #okTest).
	result := suite run.
	self assert: result failures size == 2;
		assert: result errors size == 1
%
category: 'Testing'
method: SimpleTestResource
hasRun
	^hasRun
%
category: 'Testing'
method: SimpleTestResource
hasSetup
	^hasSetup
%
category: 'Testing'
method: SimpleTestResource
isAvailable
	
	^self runningState == self startedStateSymbol
%
category: 'Accessing'
method: SimpleTestResource
runningState

	^runningState
%
category: 'Accessing'
method: SimpleTestResource
runningState: aSymbol

	runningState := aSymbol
%
category: 'Running'
method: SimpleTestResource
setRun
	hasRun := true
%
category: 'Running'
method: SimpleTestResource
setUp
	
	self runningState: self startedStateSymbol.
	hasSetup := true
%
category: 'Running'
method: SimpleTestResource
startedStateSymbol

	^#started
%
category: 'Running'
method: SimpleTestResource
stoppedStateSymbol

	^#stopped
%
category: 'Running'
method: SimpleTestResource
tearDown

	self runningState: self stoppedStateSymbol
%
category: 'other'
classmethod: SimpleTestResourceTestCase
resources
	^Set new add: SimpleTestResource; yourself
%
category: 'other'
method: SimpleTestResourceTestCase
dummy
	self assert: true
%
category: 'other'
method: SimpleTestResourceTestCase
error
	'foo' odd
%
category: 'other'
method: SimpleTestResourceTestCase
fail
	self assert: false
%
category: 'other'
method: SimpleTestResourceTestCase
setRun
	resource setRun
%
category: 'other'
method: SimpleTestResourceTestCase
setUp
	resource := SimpleTestResource current
%
category: 'other'
method: SimpleTestResourceTestCase
testRan
	| case |

	case := self class selector: #setRun.
	case run.
	self assert: resource hasSetup.
	self assert: resource hasRun
%
category: 'other'
method: SimpleTestResourceTestCase
testResourceInitRelease
	| result suite error failure |
	suite := TestSuite new.
	suite addTest: (error := self class selector: #error).
	suite addTest: (failure := self class selector: #fail).
	suite addTest: (self class selector: #dummy).
	result := suite run.
	self assert: resource hasSetup
%
category: 'other'
method: SimpleTestResourceTestCase
testResourcesCollection
	| collection |
	collection := self resources.
	self assert: collection size == 1
%
category: 'other'
classmethod: SUnitTest
COMMENT

"This is both an example of writing tests and a self test for the SUnit. The tests 
here are pretty strange, since you want to make sure things blow up. You should 
not generally have to write tests this complicated in structure, although they 
will be far more complicated in terms of your own objects- more assertions, more 
complicated setup. Kent says: 'Never forget, however, that if the tests are hard 
to write, something is probably wrong with the design'."
%
category: 'Private'
method: SUnitTest
assertForTestResult: aResult runCount: aRunCount passed: aPassedCount failed: aFailureCount errors: anErrorCount

	self
		assert: aResult runCount = aRunCount;
		assert: aResult passedCount = aPassedCount;
		assert: aResult failureCount = aFailureCount;
		assert: aResult errorCount = anErrorCount
%
category: 'Private'
method: SUnitTest
error
	3 zork
%
category: 'Testing'
method: SUnitTest
errorShouldntRaise
	self 
		shouldnt: [self someMessageThatIsntUnderstood] 
		raise: SUnitNameResolver notificationObject
%
category: 'other'
method: SUnitTest
errorTest
	1 zork
%
category: 'Private'
method: SUnitTest
fail
	self assert: false
%
category: 'other'
method: SUnitTest
failureLog
	^SUnitNameResolver defaultLogDevice
%
category: 'other'
method: SUnitTest
failureTest
	self
		assert: false description: 'You should see me' resumable: true; 
		assert: false description: 'You should see me too' resumable: true; 
		assert: false description: 'You should see me last' resumable: false; 
		assert: false description: 'You should not see me' resumable: true
%
category: 'Accessing'
method: SUnitTest
hasRun
	^hasRun
%
category: 'Accessing'
method: SUnitTest
hasSetup
	^hasSetup
%
category: 'other'
method: SUnitTest
isLogging
	^false
%
category: 'Private'
method: SUnitTest
noop
%
category: 'other'
method: SUnitTest
okTest
	self assert: true
%
category: 'other'
method: SUnitTest
regularTestFailureTest
	self assert: false description: 'You should see me'
%
category: 'other'
method: SUnitTest
resumableTestFailureTest
	self
		assert: false description: 'You should see me' resumable: true; 
		assert: false description: 'You should see me too' resumable: true; 
		assert: false description: 'You should see me last' resumable: false; 
		assert: false description: 'You should not see me' resumable: true
%
category: 'Private'
method: SUnitTest
setRun
	hasRun := true
%
category: 'Running'
method: SUnitTest
setUp
	hasSetup := true
%
category: 'Testing'
method: SUnitTest
testAssert
	self assert: true.
	self deny: false
%
category: 'Testing'
method: SUnitTest
testDefects
	| result suite error failure |
	suite := TestSuite new.
	suite addTest: (error := self class selector: #error).
	suite addTest: (failure := self class selector: #fail).
	result := suite run.
	self assert: result defects asArray = (Array with: error with: failure).
	self
		assertForTestResult: result
		runCount: 2
		passed: 0
		failed: 1
		errors: 1
%
category: 'Testing'
method: SUnitTest
testDialectLocalizedException

	self
		should: [TestResult signalFailureWith: 'Foo']
		raise: TestResult failure.
	self
		should: [TestResult signalErrorWith: 'Foo']
		raise: TestResult error.
%
category: 'Testing'
method: SUnitTest
testError

	| case result |

	case := self class selector: #error.
	result := case run.
	self
		assertForTestResult: result
		runCount: 1
		passed: 0
		failed: 0
		errors: 1.

	case := self class selector: #errorShouldntRaise.
	result := case run.
	self 
		assertForTestResult: result
		runCount: 1
		passed: 0
		failed: 0
		errors: 1
%
category: 'Testing'
method: SUnitTest
testException

	self
		should: [self error: 'foo']
		raise: TestResult error
%
category: 'Testing'
method: SUnitTest
testFail

	| case result |

	case := self class selector: #fail.
	result := case run.

	self
		assertForTestResult: result
		runCount: 1
		passed: 0
		failed: 1
		errors: 0
%
category: 'Testing'
method: SUnitTest
testIsNotRerunOnDebug

	| case |

	case := self class selector: #testRanOnlyOnce.
	case run.
	case debug
%
category: 'Testing'
method: SUnitTest
testRan

	| case |

	case := self class selector: #setRun.
	case run.
	self assert: case hasSetup.
	self assert: case hasRun
%
category: 'Testing'
method: SUnitTest
testRanOnlyOnce

	self assert: hasRanOnce ~= true.
	hasRanOnce := true
%
category: 'Testing'
method: SUnitTest
testResult

	| case result |

	case := self class selector: #noop.
	result := case run.

	self
		assertForTestResult: result
		runCount: 1
		passed: 1
		failed: 0
		errors: 0
%
category: 'Testing'
method: SUnitTest
testResumable
	| result suite |
	suite := TestSuite new.
	suite addTest: (self class selector: #errorTest).
	suite addTest: (self class selector: #regularTestFailureTest).
	suite addTest: (self class selector: #resumableTestFailureTest).
	suite addTest: (self class selector: #okTest).
	result := suite run.
	self assert: result failures size == 2;
		assert: result errors size == 1
%
category: 'Testing'
method: SUnitTest
testRunning

	(SUnitDelay forSeconds: 2) wait
%
category: 'Testing'
method: SUnitTest
testShould

	self
		should: [true];
		shouldnt: [false]
%
category: 'Testing'
method: SUnitTest
testSuite

	| suite result |

	suite := TestSuite new.
	suite 
		addTest: (self class selector: #noop);
		addTest: (self class selector: #fail);
		addTest: (self class selector: #error).

	result := suite run.

	self
		assertForTestResult: result
		runCount: 3
		passed: 1
		failed: 1
		errors: 1
%
