[squeak-dev] The Inbox: SUnit-pre.144.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jul 14 14:11:21 UTC 2022


A new version of SUnit was added to project The Inbox:
http://source.squeak.org/inbox/SUnit-pre.144.mcz

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

Name: SUnit-pre.144
Author: pre
Time: 20 June 2022, 11:43:29.010453 am
UUID: 4a255aa0-d41d-6b4e-9155-e0c22f75350a
Ancestors: SUnit-ct.143

Reverts changes of the internal usage of #targetClass and #classToBeTested in ClassTestCase to preserve the previous behavior in light of the feature freeze. ClassTestCases overriding #targetClass will now continue to work from 5.3 to 6.0.

=============== Diff against SUnit-ct.143 ===============

Item was removed:
- SystemOrganization addCategory: #'SUnit-Extensions'!
- SystemOrganization addCategory: #'SUnit-Kernel'!
- SystemOrganization addCategory: #'SUnit-Tests'!

Item was removed:
- Object subclass: #ClassFactoryForTestCase
- 	instanceVariableNames: 'createdClasses'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Extensions'!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>cleanUp (in category 'cleaning') -----
- cleanUp
- 	| createdClassNames |
- 	createdClassNames := self createdClassNames.
- 	self deleteClasses.
- 	self deletePackage.
- 	self cleanUpChangeSetForClassNames: createdClassNames.
- 	self createdClasses: IdentitySet new!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>cleanUpChangeSetForClassNames: (in category 'cleaning') -----
- cleanUpChangeSetForClassNames: classeNames
- 	| changeSet |
- 	changeSet := ChangeSet current.
- 	classeNames do: [:name|
- 		changeSet 
- 			removeClassChanges: name;
- 			removeClassChanges: name, ' class'].	!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>createdClassNames (in category 'accessing') -----
- createdClassNames
- 	^self createdClasses collect: [:class| class name]!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>createdClasses (in category 'accessing') -----
- createdClasses
- 	^createdClasses!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>createdClasses: (in category 'accessing') -----
- createdClasses: classes
- 	createdClasses := classes asIdentitySet !

Item was removed:
- ----- Method: ClassFactoryForTestCase>>defaultCategory (in category 'accessing') -----
- defaultCategory
- 	^ (self packageName , '-', self defaultCategoryPostfix) asSymbol!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>defaultCategoryPostfix (in category 'accessing') -----
- defaultCategoryPostfix
- 	^ #Default!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>delete: (in category 'cleaning') -----
- delete: aClass
- 	aClass isObsolete ifTrue: [^self].
- 	aClass removeFromChanges.
- 	aClass removeFromSystemUnlogged
- !

Item was removed:
- ----- Method: ClassFactoryForTestCase>>deleteClasses (in category 'cleaning') -----
- deleteClasses
- 	self createdClasses do: [:class|
- 		self delete: class]!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>deletePackage (in category 'cleaning') -----
- deletePackage
- 	| categoriesMatchString |
- 	categoriesMatchString := self packageName, '-*'.
- 	SystemOrganization removeCategoriesMatching: categoriesMatchString!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>initialize (in category 'cleaning') -----
- initialize
- 	super initialize.
- 	self createdClasses: IdentitySet new!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>newClass (in category 'creating') -----
- newClass
- 	^self newSubclassOf: Object instanceVariableNames: '' classVariableNames: ''!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>newClassInCategory: (in category 'creating') -----
- newClassInCategory: category
- 	^self newSubclassOf: Object instanceVariableNames: '' classVariableNames: '' category: category!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>newName (in category 'creating') -----
- newName
- 
- 	^String new: 23 + 22 streamContents: [ :stream |
- 		| random |
- 		stream nextPutAll: 'ClassForTestToBeDeleted'.
- 		random := ThreadSafeRandom value.
- 		"62 possible values, 5.95 bits / iteration, 22 iterations => more than 128 bits"
- 		22 timesRepeat: [
- 			stream nextPut: ('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' atRandom: random) ] ]!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>newSubclassOf:instanceVariableNames:classVariableNames: (in category 'creating') -----
- newSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString 
- 	^self 
- 		newSubclassOf: aClass 
- 		instanceVariableNames: ivNamesString 
- 		classVariableNames: classVarsString 
- 		category: self defaultCategoryPostfix!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>newSubclassOf:instanceVariableNames:classVariableNames:category: (in category 'creating') -----
- newSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString category: category
- 	| newClass |
- 	newClass := aClass 
- 		subclass: self newName asSymbol
- 		instanceVariableNames: ivNamesString 
- 		classVariableNames: classVarsString 
- 		poolDictionaries: '' 
- 		category: (self packageName, '-', category) asSymbol.
- 	self createdClasses add: newClass.
- 	^newClass!

Item was removed:
- ----- Method: ClassFactoryForTestCase>>packageName (in category 'accessing') -----
- packageName
- 	^#CategoryForTestToBeDeleted!

Item was removed:
- TestCase subclass: #ClassFactoryForTestCaseTest
- 	instanceVariableNames: 'factory'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Tests'!

Item was removed:
- ----- Method: ClassFactoryForTestCaseTest>>setUp (in category 'running') -----
- setUp
- 	super setUp.
- 	factory := ClassFactoryForTestCase new!

Item was removed:
- ----- Method: ClassFactoryForTestCaseTest>>tearDown (in category 'running') -----
- tearDown
- 	
- 	[factory cleanUp]
- 		ensure: [super tearDown].!

Item was removed:
- ----- Method: ClassFactoryForTestCaseTest>>testClassCreationInDifferentCategories (in category 'tests') -----
- testClassCreationInDifferentCategories
- 	| firstThreeClasses lastTwoClasses |
- 	3 timesRepeat: [
- 		factory newSubclassOf: Object instanceVariableNames: '' classVariableNames: '' category: #One].
- 	firstThreeClasses := factory createdClasses copy.
- 	2 timesRepeat: [
- 		factory newSubclassOf: Object instanceVariableNames: '' classVariableNames: '' category: #Two].
- 	lastTwoClasses := factory createdClasses copyWithoutAll: firstThreeClasses.
- 	self assert: (firstThreeClasses allSatisfy: [:class| class category = (factory packageName, '-', #One) asSymbol]).
- 	self assert: (lastTwoClasses allSatisfy: [:class| class category = (factory packageName, '-', #Two) asSymbol]).!

Item was removed:
- ----- Method: ClassFactoryForTestCaseTest>>testClassFastCreationInDifferentCategories (in category 'tests') -----
- testClassFastCreationInDifferentCategories
- 	| firstThreeClasses lastTwoClasses |
- 	3 timesRepeat: [
- 		factory newClassInCategory: #One].
- 	firstThreeClasses := factory createdClasses copy.
- 	2 timesRepeat: [
- 		factory newClassInCategory: #Two].
- 	lastTwoClasses := factory createdClasses copyWithoutAll: firstThreeClasses.
- 	self assert: (firstThreeClasses allSatisfy: [:class| class category = (factory packageName, '-', #One) asSymbol]).
- 	self assert: (lastTwoClasses allSatisfy: [:class| class category = (factory packageName, '-', #Two) asSymbol]).!

Item was removed:
- ----- Method: ClassFactoryForTestCaseTest>>testDefaultCategoryCleanUp (in category 'tests') -----
- testDefaultCategoryCleanUp
- 	| createdClassNames allClasses |
- 	3 timesRepeat: [
- 		factory newClass].
- 	createdClassNames := factory createdClassNames.
- 	factory cleanUp.	
- 	self assert: (factory createdClasses allSatisfy: [:class| class isObsolete]). 
- 	allClasses := SystemNavigation new allClasses.
- 	self assert: (factory createdClasses noneSatisfy: [:class| allClasses includes: class]).
- 	self deny: (SystemOrganization categories includes: factory defaultCategory). 
- 	self deny: (ChangeSet current changedClassNames includesAnyOf: createdClassNames)
- !

Item was removed:
- ----- Method: ClassFactoryForTestCaseTest>>testMultipleClassCreation (in category 'tests') -----
- testMultipleClassCreation
- 	5 timesRepeat: [
- 		factory newClass].
- 	self assert: (SystemNavigation new allClasses includesAllOf: factory createdClasses).
- 	self assert: factory createdClassNames asSet size = 5.
- 	self assert: (SystemOrganization listAtCategoryNamed: factory defaultCategory) asSet = factory createdClassNames asSet!

Item was removed:
- ----- Method: ClassFactoryForTestCaseTest>>testPackageCleanUp (in category 'tests') -----
- testPackageCleanUp
- 	| createdClassNames allClasses |
- 	3 timesRepeat: [
- 		factory newClassInCategory: #One].
- 	2 timesRepeat: [
- 		factory newClassInCategory: #Two].
- 	createdClassNames := factory createdClassNames.
- 	factory cleanUp.	
- 	self assert: (factory createdClasses allSatisfy: [:class| class isObsolete]). 
- 	allClasses := SystemNavigation new allClasses.
- 	self assert: (factory createdClasses noneSatisfy: [:class| allClasses includes: class]).
- 	self assert: (SystemOrganization categoriesMatching: factory packageName, '*') isEmpty. 
- 	self deny: (ChangeSet current changedClassNames includesAnyOf: createdClassNames)
- !

Item was removed:
- ----- Method: ClassFactoryForTestCaseTest>>testSingleClassCreation (in category 'tests') -----
- testSingleClassCreation
- 	|class elementsInCategoryForTest |
- 	class := factory 
- 		newSubclassOf: Object 
- 		instanceVariableNames: 'a b c' 
- 		classVariableNames: 'X Y'.
- 	self assert: (SystemNavigation new allClasses includes: class).
- 	elementsInCategoryForTest := SystemOrganization listAtCategoryNamed: factory defaultCategory. 
- 	self assert: elementsInCategoryForTest = {class name}.
- 	self assert: class instVarNames = #(a b c).
- 	self assert: class classPool keys asSet = #(X Y) asSet!

Item was removed:
- ----- Method: ClassFactoryForTestCaseTest>>testSingleClassFastCreation (in category 'tests') -----
- testSingleClassFastCreation
- 	|class elementsInCategoryForTest |
- 	class := factory newClass.
- 	self assert: (SystemNavigation new allClasses includes: class).
- 	elementsInCategoryForTest := SystemOrganization listAtCategoryNamed: factory defaultCategory. 
- 	self assert: elementsInCategoryForTest = {class name}.
- 	self assert: class instVarNames isEmpty.
- 	self assert: class classPool isEmpty!

Item was removed:
- TestCase subclass: #ClassTestCase
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Extensions'!
- 
- !ClassTestCase commentStamp: 'pre 6/8/2022 11:01' prior: 0!
- This class is intended for unit tests of individual classes and their metaclasses.
- 
- It provides methods to determine the coverage of the unit tests.
- 
- Subclasses are expected to re-implement #classToBeTested and #selectorsToBeIgnored.
- 
- They should also implement to confirm that all methods have been tested.
- 
- #testCoverage
- 
- 	super testCoverage.
- 
- !

Item was removed:
- ----- Method: ClassTestCase class>>isAbstract (in category 'Testing') -----
- isAbstract
- 	"Override to true if a TestCase subclass is Abstract and should not have
- 	TestCase instances built from it"
- 
- 	^self name = #ClassTestCase
- 			!

Item was removed:
- ----- Method: ClassTestCase class>>mustTestCoverage (in category 'Testing') -----
- mustTestCoverage
- 
- 	^ false!

Item was removed:
- ----- Method: ClassTestCase>>categoriesForClass: (in category 'private') -----
- categoriesForClass: aClass
- 
-  ^ aClass organization allMethodSelectors collect: 
- 			[:each |  aClass organization categoryOfElement: each].
- !

Item was removed:
- ----- Method: ClassTestCase>>classToBeTested (in category 'coverage') -----
- classToBeTested
- 	"When overridden this should return the class for coverage 
- 	and for generic class tests (see category tests)."
- 	| className |
- 	className := self class name asText copyFrom: 0 to: self class name size - 4.
- 	^ self class environment valueOf: (className asString asSymbol).!

Item was removed:
- ----- Method: ClassTestCase>>selectorsNotTested (in category 'coverage') -----
- selectorsNotTested
- 
- 	^ self selectorsToBeTested difference: self selectorsTested.
- !

Item was removed:
- ----- Method: ClassTestCase>>selectorsTested (in category 'coverage') -----
- selectorsTested
- 	| literals |
- 	literals := Set new.
- 	self class
- 		selectorsAndMethodsDo: [ :s :m | (s beginsWith: 'test')
- 			ifTrue: [ literals addAll: (m messages)] ].
- 	^ literals sorted!

Item was removed:
- ----- Method: ClassTestCase>>selectorsToBeIgnored (in category 'coverage') -----
- selectorsToBeIgnored
- 	^ #(#DoIt #DoItIn:)!

Item was removed:
- ----- Method: ClassTestCase>>selectorsToBeTested (in category 'coverage') -----
- selectorsToBeTested
- 
- 	^ ( { self classToBeTested. self classToBeTested class } gather: [:c | c selectors]) 
- 			difference: self selectorsToBeIgnored!

Item was removed:
- ----- Method: ClassTestCase>>targetClass (in category 'private') -----
- targetClass
- 
- 	self flag: #deprecate.
- 	^ self classToBeTested!

Item was removed:
- ----- Method: ClassTestCase>>testClassComment (in category 'tests') -----
- testClassComment
- 	self shouldnt: [self classToBeTested organization hasNoComment].!

Item was removed:
- ----- Method: ClassTestCase>>testCoverage (in category 'tests') -----
- testCoverage
- 
- 	| untested | 
- 	self class mustTestCoverage ifTrue: [
- 		untested := self selectorsNotTested.
- 		self 
- 			assert: untested isEmpty 
- 			description: untested size asString, ' selectors are not covered']!

Item was removed:
- ----- Method: ClassTestCase>>testNew (in category 'tests') -----
- testNew
- 	"This should not throw an exception."
- 	self classToBeTested new.!

Item was removed:
- ----- Method: ClassTestCase>>testUnCategorizedMethods (in category 'tests') -----
- testUnCategorizedMethods
- 	| categories slips uncategorisedMethods |
- 	categories := self categoriesForClass: self classToBeTested.
- 	slips := categories select: [:each | each = #'as yet unclassified'].
- 	
- 	uncategorisedMethods := self classToBeTested organization listAtCategoryNamed: #'as yet unclassified'.
- 	
- 	self assert: slips isEmpty description: ('{1} has uncategorised methods: {2}' format: {self classToBeTested. (uncategorisedMethods collect: #printString) asCommaString}).!

Item was removed:
- TestCase subclass: #LongTestCase
- 	instanceVariableNames: ''
- 	classVariableNames: 'ShouldRun'
- 	poolDictionaries: ''
- 	category: 'SUnit-Extensions'!
- 
- !LongTestCase commentStamp: 'ul 12/15/2009 13:06' prior: 0!
- A LongTestCase is a TestCase that usually takes a long time to run. Because of this users can decide if they want to execute these or not, by changing the "Run long test cases" preference.!

Item was removed:
- ----- Method: LongTestCase class>>allTestSelectors (in category 'accessing') -----
- allTestSelectors
- 
- 	self shouldRun ifTrue: [
- 		^super testSelectors ].
- 	^#().!

Item was removed:
- ----- Method: LongTestCase class>>buildSuite (in category 'instance creation') -----
- buildSuite
- 
- 	self shouldRun ifTrue: [ ^super buildSuite ].
- 	^self suiteClass new!

Item was removed:
- ----- Method: LongTestCase class>>doNotRunLongTestCases (in category 'accessing') -----
- doNotRunLongTestCases
- 
- 	self shouldRun: false!

Item was removed:
- ----- Method: LongTestCase class>>isAbstract (in category 'testing') -----
- isAbstract
- 	"Override to true if a TestCase subclass is Abstract and should not have
- 	TestCase instances built from it"
- 
- 	^self name == #LongTestCase
- 			!

Item was removed:
- ----- Method: LongTestCase class>>runLongTestCases (in category 'accessing') -----
- runLongTestCases
- 
- 	self shouldRun: true!

Item was removed:
- ----- Method: LongTestCase class>>shouldRun (in category 'accessing') -----
- shouldRun
- 
- 	<preference: 'Run long test cases'
- 		category: 'SUnit'
- 		description: 'If true, the tests defined as taking a long time to run (those  in subclasses of LongTestCase) will run when they are selected in the Test Runner.'
- 		type: #Boolean>
- 	^ShouldRun ifNil: [ true ]!

Item was removed:
- ----- Method: LongTestCase class>>shouldRun: (in category 'accessing') -----
- shouldRun: aBoolean
- 
- 	ShouldRun := aBoolean!

Item was removed:
- ----- Method: LongTestCase>>defaultTimeout (in category 'accessing') -----
- defaultTimeout
- 	"Answer the default timeout to use for tests in this test case. The timeout is a value in seconds."
- 
- 	^super defaultTimeout * 10!

Item was removed:
- TestCase subclass: #LongTestCaseTest
- 	instanceVariableNames: 'preferenceValue'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Extensions'!

Item was removed:
- ----- Method: LongTestCaseTest>>setUp (in category 'running') -----
- setUp
- 
- 	super setUp.
- 	
- 	preferenceValue := LongTestCase shouldRun!

Item was removed:
- ----- Method: LongTestCaseTest>>tearDown (in category 'running') -----
- tearDown
- 
- 	[LongTestCase shouldRun: preferenceValue]
- 		ensure: [super tearDown].!

Item was removed:
- ----- Method: LongTestCaseTest>>testLongTestCaseDoNotRun (in category 'tests') -----
- testLongTestCaseDoNotRun
- 	"self debug: #testLongTestCaseDoNotRun"
- 	"self run: #testLongTestCaseDoNotRun"
- 
- 	LongTestCase doNotRunLongTestCases.
- 	LongTestCaseTestUnderTest markAsNotRun.
- 	self deny: LongTestCaseTestUnderTest hasRun.
- 	LongTestCaseTestUnderTest suite run.
- 	self deny: LongTestCaseTestUnderTest hasRun.
- 
- 
- 	!

Item was removed:
- ----- Method: LongTestCaseTest>>testLongTestCaseRun (in category 'tests') -----
- testLongTestCaseRun
- 	"self debug: #testLongTestCaseRun"
- 	"self run: #testLongTestCaseRun"
- 
- 	LongTestCase runLongTestCases.
- 	LongTestCaseTestUnderTest markAsNotRun.
- 	self deny: LongTestCaseTestUnderTest hasRun.
- 	LongTestCaseTestUnderTest suite run.
- 	self assert: LongTestCaseTestUnderTest hasRun.
- 	LongTestCase doNotRunLongTestCases.
- 
- 	!

Item was removed:
- LongTestCase subclass: #LongTestCaseTestUnderTest
- 	instanceVariableNames: ''
- 	classVariableNames: 'RunStatus'
- 	poolDictionaries: ''
- 	category: 'SUnit-Extensions'!

Item was removed:
- ----- Method: LongTestCaseTestUnderTest class>>hasRun (in category 'accessing') -----
- hasRun
- 
- 	^ RunStatus!

Item was removed:
- ----- Method: LongTestCaseTestUnderTest class>>markAsNotRun (in category 'accessing') -----
- markAsNotRun
- 
- 	^ RunStatus := false!

Item was removed:
- ----- Method: LongTestCaseTestUnderTest>>testWhenRunMarkTestedToTrue (in category 'tests') -----
- testWhenRunMarkTestedToTrue
- 
- 
- 	RunStatus := true.!

Item was removed:
- ----- Method: MethodReference>>isTestMethod (in category '*SUnit-testing') -----
- isTestMethod
- 
- 	^self actualClass isTestClass and: [self methodSymbol isTestSelector]!

Item was removed:
- ----- Method: Object>>isTestClass (in category '*SUnit-testing') -----
- isTestClass
- 
- 	^ false!

Item was removed:
- TestFailure subclass: #ResumableTestFailure
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Kernel'!
- 
- !ResumableTestFailure commentStamp: '<historical>' prior: 0!
- A ResumableTestFailure triggers a TestFailure, but lets execution of the TestCase continue. this is useful when iterating through collections, and #assert: ing on each element. in combination with methods like testcase>>#assert:description:, this lets you run through a whole collection and note which tests pass.
- 
- here''s an example:
- 
- 	
- 
- 	(1 to: 30) do: [ :each |
- 		self assert: each odd description: each printString, ' is even' resumable: true]
- 
- for each element where #odd returns <false>, the element will be printed to the Transcript. !

Item was removed:
- ----- Method: ResumableTestFailure>>isResumable (in category 'camp smalltalk') -----
- isResumable
- 	"Of course a ResumableTestFailure is resumable ;-)"
- 
- 	^true!

Item was removed:
- ----- Method: ResumableTestFailure>>sunitExitWith: (in category 'camp smalltalk') -----
- sunitExitWith: aValue
- 	self resume: aValue!

Item was removed:
- TestCase subclass: #ResumableTestFailureTestCase
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Tests'!

Item was removed:
- ----- Method: ResumableTestFailureTestCase>>errorTest (in category 'data') -----
- errorTest
- 	1 zork
- 			!

Item was removed:
- ----- Method: ResumableTestFailureTestCase>>failureTest (in category 'data') -----
- 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
- 			!

Item was removed:
- ----- Method: ResumableTestFailureTestCase>>okTest (in category 'data') -----
- okTest
- 	self assert: true
- 			!

Item was removed:
- ----- Method: ResumableTestFailureTestCase>>regularTestFailureTest (in category 'data') -----
- regularTestFailureTest
- 	self assert: false description: 'You should see me'
- 			!

Item was removed:
- ----- Method: ResumableTestFailureTestCase>>resumableTestFailureTest (in category 'data') -----
- 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
- 			!

Item was removed:
- ----- Method: ResumableTestFailureTestCase>>testResumable (in category 'tests') -----
- 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
- 			!

Item was removed:
- TestCase subclass: #SUnitExtensionsTest
- 	instanceVariableNames: 'stream'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Tests'!

Item was removed:
- ----- Method: SUnitExtensionsTest>>assertionFailedInRaiseWithExceptionDoTest (in category 'real tests') -----
- assertionFailedInRaiseWithExceptionDoTest
- 
- 	self 
- 		should: [ Error signal ]
- 		raise: Error
- 		withExceptionDo: [ :anException | self assert: false ]!

Item was removed:
- ----- Method: SUnitExtensionsTest>>differentExceptionInShouldRaiseWithExceptionDoTest (in category 'real tests') -----
- differentExceptionInShouldRaiseWithExceptionDoTest
- 
- 	[ self 
- 		should: [ Error signal ]
- 		raise: Halt
- 		withExceptionDo: [ :anException | self assert: false description: 'should:raise:withExceptionDo: handled an exception that should not handle'] ]
- 	on: Error
- 	do: [ :anException | anException return: nil ]!

Item was removed:
- ----- Method: SUnitExtensionsTest>>errorInRaiseWithExceptionDoTest (in category 'real tests') -----
- errorInRaiseWithExceptionDoTest
- 
- 	self 
- 		should: [ Error  signal ]
- 		raise: Error
- 		withExceptionDo: [ :anException | Error signal: 'A forced error' ]!

Item was removed:
- ----- Method: SUnitExtensionsTest>>failureLog (in category 'test support') -----
- failureLog
- 	^self stream!

Item was removed:
- ----- Method: SUnitExtensionsTest>>invalidShouldNotTakeMoreThan (in category 'real tests') -----
- invalidShouldNotTakeMoreThan
- 
- 	self should: [(Delay forMilliseconds: 100) wait] notTakeMoreThan: 50 milliSeconds.!

Item was removed:
- ----- Method: SUnitExtensionsTest>>invalidShouldNotTakeMoreThanMilliseconds (in category 'real tests') -----
- invalidShouldNotTakeMoreThanMilliseconds
- 
- 	self should: [(Delay forMilliseconds: 100) wait] notTakeMoreThanMilliseconds: 50!

Item was removed:
- ----- Method: SUnitExtensionsTest>>isLogging (in category 'testing') -----
- isLogging
- 	^true!

Item was removed:
- ----- Method: SUnitExtensionsTest>>noExceptionInShouldRaiseWithExceptionDoTest (in category 'real tests') -----
- noExceptionInShouldRaiseWithExceptionDoTest
- 
- 	self 
- 		should: [  ]
- 		raise: Error
- 		withExceptionDo: [ :anException | Error signal: 'Should not get here' ]!

Item was removed:
- ----- Method: SUnitExtensionsTest>>shouldRaiseErrorTest (in category 'real tests') -----
- shouldRaiseErrorTest
- 
- 	self shouldRaiseError: [ TestResult exError signal: 'any kind of error' ]
- !

Item was removed:
- ----- Method: SUnitExtensionsTest>>shouldRaiseWithExceptionDoTest (in category 'real tests') -----
- shouldRaiseWithExceptionDoTest
- 
- 	self 
- 		should: [ Error signal: '1' ]
- 		raise: Error
- 		withExceptionDo: [ :anException | self assert: anException messageText = '1' ]!

Item was removed:
- ----- Method: SUnitExtensionsTest>>shouldRaiseWithSignalDoTest (in category 'real tests') -----
- shouldRaiseWithSignalDoTest
- 
- 	self 
- 		should: [ Error signal: '1' ]
- 		raise: Error
- 		withExceptionDo: [ :anException | self assert: anException messageText = '1' ]!

Item was removed:
- ----- Method: SUnitExtensionsTest>>stream (in category 'accessing') -----
- stream
- 	^stream ifNil: [stream := WriteStream on: String new]!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testAssertionFailedInRaiseWithExceptionDo (in category 'tests') -----
- testAssertionFailedInRaiseWithExceptionDo
- 
- 	| testCase testResult  |
- 	
- 	testCase := self class selector: #assertionFailedInRaiseWithExceptionDoTest.
- 	testResult := testCase run.
- 	
- 	self assert: (testResult failures includes: testCase).
- 	self assert: testResult failures size=1.
- 	self assert: testResult passed isEmpty.
- 	self assert: testResult errors isEmpty.
- 	
- 	!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testAutoAssertFalse (in category 'tests') -----
- testAutoAssertFalse
- 	| booleanCondition |
- 	self assert: self isLogging.
- 	self should: [ self assert: 1 = 2 description: 'self assert: 1 = 2' ] raise: TestResult failure.
- 	booleanCondition := (self stream contents lines) last = 'self assert: 1 = 2'.
- 	self assert: booleanCondition!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testAutoAssertTrue (in category 'tests') -----
- testAutoAssertTrue
- 	self assert: 1 = 1.
- 	self assert: true!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testAutoDenyFalse (in category 'tests') -----
- testAutoDenyFalse
- 	| booleanCondition |
- 	self assert: self isLogging.
- 	self should: [ self deny: 1 = 1 description: 'self deny: 1 = 1'.] raise: TestResult failure.
- 	booleanCondition := (self stream contents lines) last = 'self deny: 1 = 1'.
- 	self assert: booleanCondition!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testAutoDenyTrue (in category 'tests') -----
- testAutoDenyTrue
- 	self deny: 1 = 2.
- 	self deny: false!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testDifferentExceptionInShouldRaiseWithExceptionDo (in category 'tests') -----
- testDifferentExceptionInShouldRaiseWithExceptionDo
- 
- 	| testCase testResult  |
- 	
- 	testCase := self class selector: #differentExceptionInShouldRaiseWithExceptionDoTest.
- 	testResult := testCase run.
- 	
- 	self assert: (testResult passed includes: testCase).
- 	self assert: testResult errors isEmpty.
- 	self assert: testResult failures isEmpty.
- 	self assert: testResult passed size=1!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testEnsureInternetFails (in category 'tests') -----
- testEnsureInternetFails
- 
- 	self should: [self ensureInternetConnectionTo: ''] raise: Error!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testErrorInRaiseWithExceptionDo (in category 'tests') -----
- testErrorInRaiseWithExceptionDo
- 
- 	| testCase testResult  |
- 	
- 	testCase := self class selector: #errorInRaiseWithExceptionDoTest.
- 	testResult := testCase run.
- 		
- 	self assert: (testResult errors includes: testCase).
- 	self assert: testResult errors size=1.
- 	self assert: testResult failures isEmpty.
- 	self assert: testResult passed isEmpty.
- 	
- 	!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testExceptionWithMatchingString (in category 'tests') -----
- testExceptionWithMatchingString
- 	self should: [ Object obsolete ] raise: Error whoseDescriptionIncludes: 'NOT obsolete' description: 'tested obsoleting Object'!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testExceptionWithoutMatchingString (in category 'tests') -----
- testExceptionWithoutMatchingString
- 	self should: [ Object obsolete ] raise: Error whoseDescriptionDoesNotInclude: 'Zero' description: 'tested obsoleting Object'!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testInvalidShouldNotTakeMoreThan (in category 'tests') -----
- testInvalidShouldNotTakeMoreThan
- 
- 	| testCase testResult |
- 
- 	testCase := self class selector: #invalidShouldNotTakeMoreThan.
- 	testResult := testCase run.
- 
- 	self assert: testResult passed isEmpty.
- 	self assert: testResult failures size = 1.
- 	self assert: (testResult failures includes: testCase).
- 	self assert: testResult errors isEmpty
- 
- !

Item was removed:
- ----- Method: SUnitExtensionsTest>>testInvalidShouldNotTakeMoreThanMilliseconds (in category 'tests') -----
- testInvalidShouldNotTakeMoreThanMilliseconds
- 
- 	| testCase testResult |
- 
- 	testCase := self class selector: #invalidShouldNotTakeMoreThanMilliseconds.
- 	testResult := testCase run.
- 
- 	self assert: testResult passed isEmpty.
- 	self assert: testResult failures size = 1.
- 	self assert: (testResult failures includes: testCase).
- 	self assert: testResult errors isEmpty
- 
- !

Item was removed:
- ----- Method: SUnitExtensionsTest>>testNoExceptionInShouldRaiseWithExceptionDo (in category 'tests') -----
- testNoExceptionInShouldRaiseWithExceptionDo
- 
- 	| testCase testResult  |
- 	
- 	testCase := self class selector: #noExceptionInShouldRaiseWithExceptionDoTest.
- 	testResult := testCase run.
- 	
- 	self assert: (testResult failures includes: testCase).
- 	self assert: testResult failures size=1.
- 	self assert: testResult passed isEmpty.
- 	self assert: testResult errors isEmpty.
- 	
- 	!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testNoExceptionWithMatchingString (in category 'tests') -----
- testNoExceptionWithMatchingString
- 	self shouldnt: [ Object obsolete ] raise: Error whoseDescriptionIncludes: 'Zero' description: 'tested obsoleting Object'!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testNoExceptionWithNoMatchingString (in category 'tests') -----
- testNoExceptionWithNoMatchingString
- 	self shouldnt: [ Object obsolete ] raise: Error whoseDescriptionDoesNotInclude: 'NOT' description: 'tested obsoleting Object'!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testShouldRaiseError (in category 'tests') -----
- testShouldRaiseError
- 
- 	| testCase testResult  |
- 	testCase := self class selector: #shouldRaiseErrorTest.
- 	testResult := testCase run.
- 	
- 	self assert: (testResult passed includes: testCase).
- 	self assert: 1 equals: testResult passed size.
- 	self assert: testResult failures isEmpty.
- 	self assert: testResult errors isEmpty.!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testShouldRaiseWithExceptionDo (in category 'tests') -----
- testShouldRaiseWithExceptionDo
- 
- 	| testCase testResult  |
- 	
- 	testCase := self class selector: #shouldRaiseWithExceptionDoTest.
- 	testResult := testCase run.
- 	
- 	self assert: (testResult passed includes: testCase).
- 	self assert: testResult passed size=1.
- 	self assert: testResult failures isEmpty.
- 	self assert: testResult errors isEmpty.
- 	
- 	!

Item was removed:
- ----- Method: SUnitExtensionsTest>>testValidShouldNotTakeMoreThan (in category 'tests') -----
- testValidShouldNotTakeMoreThan
- 	| testCase testResult |
- 
- 	testCase := self class selector: #validShouldNotTakeMoreThan.
- 	testResult := testCase run.
- 
- 	self assert: (testResult passed includes: testCase).
- 	self assert: testResult passed size = 1.
- 	self assert: testResult failures isEmpty.
- 	self assert: testResult errors isEmpty
- 
- !

Item was removed:
- ----- Method: SUnitExtensionsTest>>testValidShouldNotTakeMoreThanMilliseconds (in category 'tests') -----
- testValidShouldNotTakeMoreThanMilliseconds
- 
- 	| testCase testResult |
- 
- 	testCase := self class selector: #validShouldNotTakeMoreThanMilliseconds.
- 	testResult := testCase run.
- 
- 	self assert: (testResult passed includes: testCase).
- 	self assert: testResult passed size = 1.
- 	self assert: testResult failures isEmpty.
- 	self assert: testResult errors isEmpty
- 
- !

Item was removed:
- ----- Method: SUnitExtensionsTest>>validShouldNotTakeMoreThan (in category 'real tests') -----
- validShouldNotTakeMoreThan
- 
- 	self should: [(Delay forMilliseconds: 100) wait] notTakeMoreThan:  200 milliSeconds.!

Item was removed:
- ----- Method: SUnitExtensionsTest>>validShouldNotTakeMoreThanMilliseconds (in category 'real tests') -----
- validShouldNotTakeMoreThanMilliseconds
- 
- 	self should: [(Delay forMilliseconds: 100) wait] notTakeMoreThanMilliseconds: 200!

Item was removed:
- TestCase subclass: #SUnitTest
- 	instanceVariableNames: 'hasRun hasSetup hasRanOnce'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Tests'!
- 
- !SUnitTest commentStamp: '<historical>' prior: 0!
- 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".!

Item was removed:
- ----- Method: SUnitTest>>assertForTestResult:runCount:passed:failed:errors: (in category 'private') -----
- 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
- 			!

Item was removed:
- ----- Method: SUnitTest>>defaultTimeout (in category 'accessing') -----
- defaultTimeout
- 
- 	self selector = #testTestTimeout ifTrue: [
- 		^ 0.3 "seconds"].
- 	^ super defaultTimeout!

Item was removed:
- ----- Method: SUnitTest>>error (in category 'private') -----
- error
- 	3 zork
- 			!

Item was removed:
- ----- Method: SUnitTest>>errorShouldntRaise (in category 'tests') -----
- errorShouldntRaise
- 	self 
- 		shouldnt: [self someMessageThatIsntUnderstood] 
- 		raise: Notification new
- 			!

Item was removed:
- ----- Method: SUnitTest>>fail (in category 'private') -----
- fail
- 	self assert: false
- 			!

Item was removed:
- ----- Method: SUnitTest>>hasRun (in category 'accessing') -----
- hasRun
- 	^hasRun
- 			!

Item was removed:
- ----- Method: SUnitTest>>hasSetup (in category 'accessing') -----
- hasSetup
- 	^hasSetup
- 			!

Item was removed:
- ----- Method: SUnitTest>>noop (in category 'private') -----
- noop
- 			!

Item was removed:
- ----- Method: SUnitTest>>setRun (in category 'private') -----
- setRun
- 	hasRun := true
- 			!

Item was removed:
- ----- Method: SUnitTest>>setUp (in category 'running') -----
- setUp
- 
- 	super setUp.
- 	
- 	hasSetup := true.!

Item was removed:
- ----- Method: SUnitTest>>testAssert (in category 'tests') -----
- testAssert
- 	self assert: true.
- 	self deny: false
- 			!

Item was removed:
- ----- Method: SUnitTest>>testAssertEquals (in category 'tests') -----
- testAssertEquals
- 
- 	| a b |
- 	a := 'foo'.
- 	b := 'bar'.
- 	
- 	self shouldnt: [self assert: a equals: a copy] raise: TestFailure.
- 	
- 	self
- 		should: [self assert: a equals: b]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			| error |
- 			error := ex messageText.
- 			self
- 				assert: (error includesSubstring: a)
- 				description: 'Error message doesn''t include the expected value'.
- 			self
- 				assert: (error includesSubstring: b)
- 				description: 'Error message doesn''t include the actual value'].!

Item was removed:
- ----- Method: SUnitTest>>testAssertEqualsDescription (in category 'tests') -----
- testAssertEqualsDescription
- 
- 	| a b called |
- 	a := 'foo'.
- 	b := 'bar'.
- 	
- 	self shouldnt: [self assert: a equals: a copy description: 'A description42'] raise: TestFailure.
- 	
- 	self
- 		should: [self assert: a equals: b description: 'A description42']
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'A description42')
- 				description: 'Error message doesn''t give you the description'].
- 	
- 	called := false.
- 	self shouldnt: [self assert: a equals: a description: [called := true]] raise: TestFailure.
- 	self deny: called description: 'Description block was evaluated prematurely'.
- 	
- 	self
- 		should: [self assert: a equals: b description: ['A generated description' asUppercase]]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'A generated description' asUppercase)
- 				description: 'Error message doesn''t give you the generated description'].!

Item was removed:
- ----- Method: SUnitTest>>testAssertIdentical (in category 'tests') -----
- testAssertIdentical
- 
- 	| a b |
- 	a := 'foo'.
- 	b := 'bar'.
- 	
- 	self shouldnt: [self assert: a identical: a] raise: TestFailure.
- 	
- 	self
- 		should: [self assert: a identical: b]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			| error |
- 			error := ex messageText.
- 			self
- 				assert: (error includesSubstring: a)
- 				description: 'Error message doesn''t include the expected value'.
- 			self
- 				assert: (error includesSubstring: b)
- 				description: 'Error message doesn''t include the actual value'].!

Item was removed:
- ----- Method: SUnitTest>>testAssertIdenticalDescription (in category 'tests') -----
- testAssertIdenticalDescription
- 
- 	| a b called |
- 	a := 'foo'.
- 	b := a copy.
- 	
- 	self shouldnt: [self assert: a identical: a description: 'A description42'] raise: TestFailure.
- 	
- 	self
- 		should: [self assert: a identical: b description: 'A description42']
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'A description42')
- 				description: 'Error message doesn''t give you the description'].
- 	
- 	called := false.
- 	self shouldnt: [self assert: a identical: a description: [called := true]] raise: TestFailure.
- 	self deny: called description: 'Description block was evaluated prematurely'.
- 	
- 	self
- 		should: [self assert: a identical: b description: ['A generated description' asUppercase]]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'A generated description' asUppercase)
- 				description: 'Error message doesn''t give you the generated description'].!

Item was removed:
- ----- Method: SUnitTest>>testAssertIdenticalWithEqualObjects (in category 'tests') -----
- testAssertIdenticalWithEqualObjects
- 
- 	| a b |
- 	a := 'foo'.
- 	b := a copy.
- 	
- 	self
- 		should: [self assert: a identical: b]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'not identical')
- 				description: 'Error message doesn''t say the two things aren''t identical'].!

Item was removed:
- ----- Method: SUnitTest>>testDefects (in category 'tests') -----
- 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
- 			!

Item was removed:
- ----- Method: SUnitTest>>testDenyEquals (in category 'tests') -----
- testDenyEquals
- 
- 	| a b |
- 	a := 'foo'.
- 	b := 'bar'.
- 	
- 	self shouldnt: [self deny: a equals: b] raise: TestFailure.
- 	
- 	self
- 		should: [self deny: a equals: a copy]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: a)
- 				description: 'Error message doesn''t include the unexpected value'].!

Item was removed:
- ----- Method: SUnitTest>>testDenyEqualsDescription (in category 'tests') -----
- testDenyEqualsDescription
- 
- 	| a b called |
- 	a := 'foo'.
- 	b := 'bar'.
- 	
- 	self shouldnt: [self deny: a equals: b description: 'A description42'] raise: TestFailure.
- 	
- 	self
- 		should: [self deny: a equals: a copy description: 'A description42']
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'A description42')
- 				description: 'Error message doesn''t give you the description'].
- 	
- 	called := false.
- 	self shouldnt: [self deny: a equals: b description: [called := true]] raise: TestFailure.
- 	self deny: called description: 'Description block was evaluated prematurely'.
- 	
- 	self
- 		should: [self deny: a equals: a description: ['A generated description' asUppercase]]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'A generated description' asUppercase)
- 				description: 'Error message doesn''t give you the generated description'].!

Item was removed:
- ----- Method: SUnitTest>>testDenyIdentical (in category 'tests') -----
- testDenyIdentical
- 
- 	| a b |
- 	a := 'foo'.
- 	b := 'bar'.
- 	self shouldnt: [self deny: a identical: b] raise: TestFailure.
- 	self
- 		should: [self deny: a identical: a]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: a)
- 				description: 'Error message doesn''t include the unexpected value'].!

Item was removed:
- ----- Method: SUnitTest>>testDenyIdenticalDescription (in category 'tests') -----
- testDenyIdenticalDescription
- 
- 	| a b called |
- 	a := 'foo'.
- 	b := a copy.
- 	
- 	self shouldnt: [self deny: a identical: b description: 'A description42'] raise: TestFailure.
- 	
- 	self
- 		should: [self deny: a identical: a description: 'A description42']
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'A description42')
- 				description: 'Error message doesn''t give you the description'].
- 	
- 	called := false.
- 	self shouldnt: [self deny: a identical: b description: [called := true]] raise: TestFailure.
- 	self deny: called description: 'Description block was evaluated prematurely'.
- 	
- 	self
- 		should: [self deny: a identical: a description: ['A generated description' asUppercase]]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'A generated description' asUppercase)
- 				description: 'Error message doesn''t give you the description'].!

Item was removed:
- ----- Method: SUnitTest>>testDenyIdenticalWithEqualObjects (in category 'tests') -----
- testDenyIdenticalWithEqualObjects
- 
- 	| a b |
- 	a := 'foo'.
- 	b := a copy.
- 	self
- 		should: [self deny: a identical: a]
- 		raise: TestFailure
- 		withExceptionDo: [:ex |
- 			self
- 				assert: (ex messageText includesSubstring: 'identical')
- 				description: 'Error message doesn''t say the two things are identical'].!

Item was removed:
- ----- Method: SUnitTest>>testDialectLocalizedException (in category 'tests') -----
- testDialectLocalizedException
- 
- 	self
- 		should: [TestResult signalFailureWith: 'Foo']
- 		raise: TestResult failure.
- 	self
- 		should: [TestResult signalErrorWith: 'Foo']
- 		raise: TestResult exError.!

Item was removed:
- ----- Method: SUnitTest>>testError (in category 'tests') -----
- 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
- 			!

Item was removed:
- ----- Method: SUnitTest>>testException (in category 'tests') -----
- testException
- 
- 	self
- 		should: [self error: 'foo']
- 		raise: TestResult exError!

Item was removed:
- ----- Method: SUnitTest>>testFail (in category 'tests') -----
- testFail
- 
- 	| case result |
- 
- 	case := self class selector: #fail.
- 	result := case run.
- 
- 	self
- 		assertForTestResult: result
- 		runCount: 1
- 		passed: 0
- 		failed: 1
- 		errors: 0
- 			!

Item was removed:
- ----- Method: SUnitTest>>testRan (in category 'tests') -----
- testRan
- 
- 	| case |
- 
- 	case := self class selector: #setRun.
- 	case run.
- 	self assert: case hasSetup.
- 	self assert: case hasRun
- 			!

Item was removed:
- ----- Method: SUnitTest>>testRanOnlyOnce (in category 'tests') -----
- testRanOnlyOnce
- 
- 	self assert: hasRanOnce ~= true.
- 	hasRanOnce := true
- 			!

Item was removed:
- ----- Method: SUnitTest>>testResult (in category 'tests') -----
- testResult
- 
- 	| case result |
- 
- 	case := self class selector: #noop.
- 	result := case run.
- 
- 	self
- 		assertForTestResult: result
- 		runCount: 1
- 		passed: 1
- 		failed: 0
- 		errors: 0
- 			!

Item was removed:
- ----- Method: SUnitTest>>testRunning (in category 'tests') -----
- testRunning
- 
- 	0.2 seconds wait.
- 			!

Item was removed:
- ----- Method: SUnitTest>>testSelectorWithArg: (in category 'tests') -----
- testSelectorWithArg: anObject
- 	"should not result in error"!

Item was removed:
- ----- Method: SUnitTest>>testShould (in category 'tests') -----
- testShould
- 
- 	self
- 		should: [true];
- 		shouldnt: [false]
- 			!

Item was removed:
- ----- Method: SUnitTest>>testSuite (in category 'tests') -----
- 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
- 			!

Item was removed:
- ----- Method: SUnitTest>>testTestTimeout (in category 'tests') -----
- testTestTimeout
- 
- 	self
- 		shouldnt: [(self timeoutForTest / 2) seconds wait]
- 		raise: TestFailure.
- 	self
- 		should: [(self timeoutForTest / 2 + 0.1) seconds wait]
- 		raise: TestFailure.!

Item was removed:
- ----- Method: SUnitTest>>testTestTimeoutLoop (in category 'tests') -----
- testTestTimeoutLoop
- 	<timeout: 0.1 "seconds">
- 	self
- 		should: [[] repeat]
- 		raise: TestFailure.
- !

Item was removed:
- ----- Method: SUnitTest>>testTestTimeoutPragma (in category 'tests') -----
- testTestTimeoutPragma
- 	<timeout: 0.1 "seconds">
- 	self
- 		shouldnt: [0.05 seconds wait]
- 		raise: TestFailure.
- 	self
- 		should: [0.05 seconds wait]
- 		raise: TestFailure.
- !

Item was removed:
- ----- Method: SUnitTest>>testWithExceptionDo (in category 'tests') -----
- testWithExceptionDo
- 
- 	self
- 		should: [self error: 'foo']
- 		raise: TestResult exError
- 		withExceptionDo: [:exception |
- 			self assert: (exception description includesSubstring: 'foo')
- 		]!

Item was removed:
- TestResource subclass: #SimpleTestResource
- 	instanceVariableNames: 'runningState hasRun hasSetup hasRanOnce'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Tests'!

Item was removed:
- ----- Method: SimpleTestResource>>hasRun (in category 'testing') -----
- hasRun
- 	^hasRun
- 			!

Item was removed:
- ----- Method: SimpleTestResource>>hasSetup (in category 'testing') -----
- hasSetup
- 	^hasSetup
- 			!

Item was removed:
- ----- Method: SimpleTestResource>>isAvailable (in category 'testing') -----
- isAvailable
- 	
- 	^self runningState == self startedStateSymbol
- 			!

Item was removed:
- ----- Method: SimpleTestResource>>runningState (in category 'accessing') -----
- runningState
- 
- 	^runningState
- 			!

Item was removed:
- ----- Method: SimpleTestResource>>runningState: (in category 'accessing') -----
- runningState: aSymbol
- 
- 	runningState := aSymbol
- 			!

Item was removed:
- ----- Method: SimpleTestResource>>setRun (in category 'running') -----
- setRun
- 	hasRun := true
- 			!

Item was removed:
- ----- Method: SimpleTestResource>>setUp (in category 'running') -----
- setUp
- 	
- 	self runningState: self startedStateSymbol.
- 	hasSetup := true
- 			!

Item was removed:
- ----- Method: SimpleTestResource>>startedStateSymbol (in category 'running') -----
- startedStateSymbol
- 
- 	^#started
- 			!

Item was removed:
- ----- Method: SimpleTestResource>>stoppedStateSymbol (in category 'running') -----
- stoppedStateSymbol
- 
- 	^#stopped
- 			!

Item was removed:
- ----- Method: SimpleTestResource>>tearDown (in category 'running') -----
- tearDown
- 
- 	self runningState: self stoppedStateSymbol
- 			!

Item was removed:
- TestCase subclass: #SimpleTestResourceTestCase
- 	instanceVariableNames: 'resource'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Tests'!

Item was removed:
- ----- Method: SimpleTestResourceTestCase class>>resources (in category 'not categorized') -----
- resources
- 	^Set new add: SimpleTestResource; yourself
- 			!

Item was removed:
- ----- Method: SimpleTestResourceTestCase>>dummy (in category 'private') -----
- dummy
- 	self assert: true
- 			!

Item was removed:
- ----- Method: SimpleTestResourceTestCase>>error (in category 'extensions') -----
- error
- 	'foo' odd
- 			!

Item was removed:
- ----- Method: SimpleTestResourceTestCase>>fail (in category 'extensions') -----
- fail
- 	self assert: false
- 			!

Item was removed:
- ----- Method: SimpleTestResourceTestCase>>setRun (in category 'extensions') -----
- setRun
- 	resource setRun
- 			!

Item was removed:
- ----- Method: SimpleTestResourceTestCase>>setUp (in category 'running') -----
- setUp
- 
- 	super setUp.
- 	
- 	resource := SimpleTestResource current
- 			!

Item was removed:
- ----- Method: SimpleTestResourceTestCase>>testRan (in category 'tests') -----
- testRan
- 	| case |
- 
- 	case := self class selector: #setRun.
- 	case run.
- 	self assert: resource hasSetup.
- 	self assert: resource hasRun
- 			!

Item was removed:
- ----- Method: SimpleTestResourceTestCase>>testResourceInitRelease (in category 'tests') -----
- 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
- 			!

Item was removed:
- ----- Method: SimpleTestResourceTestCase>>testResourcesCollection (in category 'tests') -----
- testResourcesCollection
- 	| collection |
- 	collection := self resources.
- 	self assert: collection size = 1
- 			!

Item was removed:
- ----- Method: Symbol>>isTestSelector (in category '*SUnit-testing') -----
- isTestSelector
- 
- 	^ self beginsWith: 'test'!

Item was removed:
- Object subclass: #TestCase
- 	instanceVariableNames: 'testSelector timeout'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Kernel'!
- TestCase class
- 	instanceVariableNames: 'history'!
- 
- !TestCase commentStamp: '<historical>' prior: 0!
- 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.!
- TestCase class
- 	instanceVariableNames: 'history'!

Item was removed:
- ----- Method: TestCase class>>addTestsFor:toSuite: (in category 'building suites') -----
- addTestsFor: classNameString toSuite: suite
- 
- 	| cls  |
- 	cls := Smalltalk at: classNameString ifAbsent: [ ^suite ].
- 	^cls isAbstract 
- 		ifTrue:  [
- 			cls allSubclasses do: [ :each |
- 				each isAbstract ifFalse: [
- 					each addToSuiteFromSelectors: suite ] ].
- 			suite]
- 		ifFalse: [ cls addToSuiteFromSelectors: suite ]
- !

Item was removed:
- ----- Method: TestCase class>>addToSuite:fromMethods: (in category 'building suites') -----
- addToSuite: suite fromMethods: testMethods 
- 	testMethods do:  [ :selector | 
- 			suite addTest: (self selector: selector) ].
- 	^suite!

Item was removed:
- ----- Method: TestCase class>>addToSuiteFromSelectors: (in category 'building suites') -----
- addToSuiteFromSelectors: suite
- 	^self addToSuite: suite fromMethods: (self shouldInheritSelectors
- 		ifTrue: [ self allTestSelectors ]
- 		ifFalse: [self testSelectors ])!

Item was removed:
- ----- Method: TestCase class>>allTestSelectors (in category 'accessing') -----
- allTestSelectors
- 
- 	^(self allSelectors asArray select: [ :each | 
- 		each isTestSelector and: [ each numArgs isZero ] ]) sort
- 			!

Item was removed:
- ----- Method: TestCase class>>buildSuite (in category 'building suites') -----
- buildSuite
- 	| suite |
- 	suite := self suiteClass new.
- 	^ self isAbstract
- 		ifTrue: [
- 			suite name: self name asString.
- 			self allSubclasses
- 				do: [:each | each isAbstract
- 						ifFalse: [each addToSuiteFromSelectors: suite]].
- 			suite]
- 		ifFalse: [self addToSuiteFromSelectors: suite]!

Item was removed:
- ----- Method: TestCase class>>buildSuiteFromAllSelectors (in category 'building suites') -----
- buildSuiteFromAllSelectors
- 
- 	^self buildSuiteFromMethods: self allTestSelectors
- 			!

Item was removed:
- ----- Method: TestCase class>>buildSuiteFromLocalSelectors (in category 'building suites') -----
- buildSuiteFromLocalSelectors
- 
- 	^self buildSuiteFromMethods: self testSelectors
- 			!

Item was removed:
- ----- Method: TestCase class>>buildSuiteFromMethods: (in category 'building suites') -----
- buildSuiteFromMethods: testMethods 
- 	| suite |
- 	suite := (self suiteClass new)
- 				name: self name asString;
- 				yourself.
- 	^self addToSuite: suite fromMethods: testMethods!

Item was removed:
- ----- Method: TestCase class>>buildSuiteFromSelectors (in category 'building suites') -----
- buildSuiteFromSelectors
- 
- 	^self shouldInheritSelectors
- 		ifTrue: [self buildSuiteFromAllSelectors]
- 		ifFalse: [self buildSuiteFromLocalSelectors]
- 			!

Item was removed:
- ----- Method: TestCase class>>cleanUp: (in category 'initialize-release') -----
- cleanUp: aggressive
- 
- 	aggressive ifTrue: [
- 		self withAllSubclassesDo: [:testCaseClass |
- 			testCaseClass resetHistory]].!

Item was removed:
- ----- Method: TestCase class>>coverage (in category 'coverage') -----
- coverage
- 	"returns the coverage determined by a simple static analysis of test coverage 
- 	made by the receiver on a class that is identified by the name of the receiver.
- 	We assume that SetTest test Set."
- 	
- 	| cls className |
- 	(self name endsWith: 'Test') ifFalse: [self error: 'Please, use #coverageForClass: instead'].
- 
- 	className := self name copyFrom: 1 to: (self name size - 'Test' size).
- 	cls := Smalltalk at: className asSymbol ifAbsent: [self error: 'Please, use #coverageForClass: instead'].
- 	
- 	"May happen with Transcript"
- 	cls isBehavior ifFalse: [cls := cls class].
- 	
- 	^ self coverageForClass: cls!

Item was removed:
- ----- Method: TestCase class>>coverageAsString (in category 'coverage') -----
- coverageAsString
- 	| cov className |
- 	cov := self coverage first asInteger. 
- 	"coverage already checks that the name is ends with 'Test' and if the class tested exists"
- 	
- 	className := self name copyFrom: 1 to: (self name size - 'Test' size).
- 	^ self name asString, ' covers ', cov asString, '% of ', className.!

Item was removed:
- ----- Method: TestCase class>>coverageForClass: (in category 'coverage') -----
- coverageForClass: cls
- 	"returns the test coverage of all the methods included inherited ones"
- 	^ self coverageForClass: cls until: ProtoObject!

Item was removed:
- ----- Method: TestCase class>>coverageForClass:until: (in category 'coverage') -----
- coverageForClass: cls until: aRootClass
- 	"returns the test coverage of all the methods included inherited ones but stopping at aRootClass included"
- 	
- 	| definedMethods testedMethods untestedMethods |
- 	definedMethods := cls allSelectorsAboveUntil: aRootClass.
- 	definedMethods size = 0
- 		ifTrue: [^ {0. Set new}].
- 	testedMethods := 
- 		self methodDictionary inject: Set new into: 
- 							[:sums :cm | sums union: cm messages].
- 	testedMethods := testedMethods reject: [:sel | (definedMethods includes: sel) not].
- 	untestedMethods := definedMethods select: [:selector | (testedMethods includes: selector) not].
- 	^ { (testedMethods size * 100 / definedMethods size) asFloat . untestedMethods}
- !

Item was removed:
- ----- Method: TestCase class>>coveragePercentage (in category 'coverage') -----
- coveragePercentage
- 	^ self coverage first!

Item was removed:
- ----- Method: TestCase class>>debug: (in category 'instance creation') -----
- debug: aSymbol
- 
- 	^(self selector: aSymbol) debug
- 			!

Item was removed:
- ----- Method: TestCase class>>generateLastStoredRunMethod (in category 'history') -----
- generateLastStoredRunMethod
- 
- 	self shouldGenerateLastStoredRunMethod ifTrue: [
- 		self class
- 			compile: (self lastRunMethodNamed: #lastStoredRun)
- 			classified: '*autogenerated-history' ]!

Item was removed:
- ----- Method: TestCase class>>hasDefects (in category 'testing') -----
- hasDefects
- 
- 	^ self hasFailures or: [self hasErrors]!

Item was removed:
- ----- Method: TestCase class>>hasErrors (in category 'testing') -----
- hasErrors
- 
- 	^ (self lastRun at: #errors) isEmpty not!

Item was removed:
- ----- Method: TestCase class>>hasFailures (in category 'testing') -----
- hasFailures
- 
- 	^ (self lastRun at: #failures) isEmpty not!

Item was removed:
- ----- Method: TestCase class>>hasMethodBeenRun: (in category 'testing') -----
- hasMethodBeenRun: aSelector
- 	^ ((self lastRun at: #errors),
- 		(self lastRun at: #failures),
- 		(self lastRun at: #passed))
- 			includes: aSelector!

Item was removed:
- ----- Method: TestCase class>>history (in category 'history') -----
- history
- 	^ history ifNil: [ history := self newTestDictionary ]!

Item was removed:
- ----- Method: TestCase class>>history: (in category 'history') -----
- history: aDictionary
- 	history := aDictionary!

Item was removed:
- ----- Method: TestCase class>>initialize (in category 'initialize - event') -----
- initialize
-      super initialize.
- 	SystemChangeNotifier uniqueInstance notify: self ofSystemChangesOfItem: #method using: #methodChanged:.!

Item was removed:
- ----- Method: TestCase class>>isAbstract (in category 'testing') -----
- isAbstract
- 	"Override to true if a TestCase subclass is Abstract and should not have
- 	TestCase instances built from it"
- 
- 	^self name = #TestCase
- 			!

Item was removed:
- ----- Method: TestCase class>>isTestClass (in category 'testing') -----
- isTestClass
- 	^ true!

Item was removed:
- ----- Method: TestCase class>>lastRun (in category 'history') -----
- lastRun
- 	^ TestResult historyFor: self!

Item was removed:
- ----- Method: TestCase class>>lastRunMethodNamed: (in category 'history') -----
- lastRunMethodNamed: aSelector
- 	
- 	^ String streamContents: [:stream |
- 		stream
- 			nextPutAll: aSelector asString;
- 			crtab; nextPutAll: ('<autogenerated> "See {1}"' format: {thisContext home});
- 			crtab; nextPutAll: '^ ', (self lastRun) storeString]
- !

Item was removed:
- ----- Method: TestCase class>>lastStoredRun (in category 'history') -----
- lastStoredRun
- 	^ ((Dictionary new) add: (#failures->#()); add: (#passed->#()); add: (#errors->#()); yourself)!

Item was removed:
- ----- Method: TestCase class>>localCoverage (in category 'coverage') -----
- localCoverage
- 	"returns the coverage determined by a simple static analysis of test coverage 
- 	made by the receiver on a class that is identified by the name of the receiver.
- 	We assume that SetTest test Set. The computation of the coverage takes only into
- 	account the methods defined locally in the tested class. See coverage for a more global 
- 	coverage"
- 	
- 	| cls className |
- 	(self name endsWith: 'Test') ifFalse: [self error: 'Please, use #localCoverageForClass: instead'].
- 	className := self name copyFrom: 1 to: (self name size - 'Test' size).
- 	cls := Smalltalk at: className asSymbol ifAbsent: [self error: 'Please, use #localCoverageForClass: instead'].
- 	cls isBehavior ifFalse: [cls := cls class].
- 	^ self localCoverageForClass: cls!

Item was removed:
- ----- Method: TestCase class>>localCoverageAsString (in category 'coverage') -----
- localCoverageAsString
- 	| cov className |
- 	cov := self localCoverage first asInteger. 
- 	"coverage already checks that the name is ends with 'Test' and if the class tested exists"
- 	
- 	className := self name copyFrom: 1 to: (self name size - 'Test' size).
- 	^ self name asString, ' covers ', cov asString, '% of ', className.!

Item was removed:
- ----- Method: TestCase class>>localCoverageForClass: (in category 'coverage') -----
- localCoverageForClass: cls
- 	
- 	| definedMethods testedMethods untestedMethods |
- 	definedMethods := cls selectors asSet.
- 	"It happens for IdentityBag / IdentityBagTest"
- 	definedMethods size = 0
- 		ifTrue: [^ {0. Set new}].
- 
- 	testedMethods := 
- 		self methodDictionary inject: Set new into: 
- 							[:sums :cm | sums union: cm messages].
- 					
- 	"testedMethods contains all the methods send in test methods, which probably contains methods that have nothign to do with collection"
- 	testedMethods := testedMethods reject: [:sel | (definedMethods includes: sel) not].
- 
- 	untestedMethods := definedMethods select: [:selector | (testedMethods includes: selector) not].
- 
- 	^ { (testedMethods size * 100 / definedMethods size) asFloat . untestedMethods}
- !

Item was removed:
- ----- Method: TestCase class>>localCoveragePercentage (in category 'coverage') -----
- localCoveragePercentage
- 	^ self localCoverage first!

Item was removed:
- ----- Method: TestCase class>>methodChanged: (in category 'initialize - event') -----
- methodChanged: anEvent
- 	"Remove the changed method from the known test results."
- 	
- 	| cls sel |
- 	anEvent item isCompiledMethod ifFalse: [ ^ self ].
- 	cls := anEvent item methodClass.
- 	(cls inheritsFrom: TestCase)
- 		ifFalse: [^ self].
- 	sel := anEvent item selector.
- 	(sel beginsWith: 'test')
- 		ifFalse: [^ self].
- 	TestResult removeFromTestHistory: sel in: cls.
- !

Item was removed:
- ----- Method: TestCase class>>methodFailed: (in category 'testing') -----
- methodFailed: aSelector
- 	^ (self lastRun at: #failures) includes: aSelector!

Item was removed:
- ----- Method: TestCase class>>methodPassed: (in category 'testing') -----
- methodPassed: aSelector
- 	^ (self lastRun at: #passed) includes: aSelector!

Item was removed:
- ----- Method: TestCase class>>methodProgressed: (in category 'testing') -----
- methodProgressed: aSelector
- 	^ ((self storedMethodRaisedError: aSelector) or: [self storedMethodFailed: aSelector])
- 		and: [self methodPassed: aSelector]
- 		!

Item was removed:
- ----- Method: TestCase class>>methodRaisedError: (in category 'testing') -----
- methodRaisedError: aSelector
- 	^ (self lastRun at: #errors) includes: aSelector!

Item was removed:
- ----- Method: TestCase class>>methodRegressed: (in category 'testing') -----
- methodRegressed: aSelector
- 	^ (self storedMethodPassed: aSelector) and: [(self methodFailed: aSelector) or: [self methodRaisedError: aSelector]]!

Item was removed:
- ----- Method: TestCase class>>newTestDictionary (in category 'history') -----
- newTestDictionary
- 
- 	^ Dictionary new at: #timeStamp put: TimeStamp now;
- 		at: #passed put: Set new;
- 		at: #failures put: Set new;
- 		at: #errors put: Set new;
- 		yourself
- 		!

Item was removed:
- ----- Method: TestCase class>>resetHistory (in category 'history') -----
- resetHistory
- 	history := nil!

Item was removed:
- ----- Method: TestCase class>>resources (in category 'accessing') -----
- resources
- 
- 	^#()
- 			!

Item was removed:
- ----- Method: TestCase class>>run: (in category 'instance creation') -----
- run: aSymbol
- 
- 	^(self selector: aSymbol) run
- 			!

Item was removed:
- ----- Method: TestCase class>>selector: (in category 'instance creation') -----
- selector: aSymbol
- 
- 	^self new setTestSelector: aSymbol
- 			!

Item was removed:
- ----- Method: TestCase class>>shouldGenerateLastStoredRunMethod (in category 'history') -----
- shouldGenerateLastStoredRunMethod
- 	| sameRun |
- 	
- 	(self class methodDictionary includesKey: #lastStoredRun)
- 		ifFalse: [^ true].
- 	sameRun := #(#passed #failures #errors) inject: true into: 
- 		[ :ok :set | ok and: [(self lastRun at: set) = (self lastStoredRun at: set) ]].
- 	^ sameRun not
- !

Item was removed:
- ----- Method: TestCase class>>shouldInheritSelectors (in category 'testing') -----
- 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)$"
- 			!

Item was removed:
- ----- Method: TestCase class>>storedMethodFailed: (in category 'testing') -----
- storedMethodFailed: aSelector
- 	^ (self lastStoredRun at: #failures) includes: aSelector!

Item was removed:
- ----- Method: TestCase class>>storedMethodPassed: (in category 'testing') -----
- storedMethodPassed: aSelector
- 	^ (self lastStoredRun at: #passed) includes: aSelector!

Item was removed:
- ----- Method: TestCase class>>storedMethodRaisedError: (in category 'testing') -----
- storedMethodRaisedError: aSelector
- 	^ (self lastStoredRun at: #errors) includes: aSelector!

Item was removed:
- ----- Method: TestCase class>>suite (in category 'instance creation') -----
- suite
- 
- 	^self buildSuite
- 			!

Item was removed:
- ----- Method: TestCase class>>suiteClass (in category 'building suites') -----
- suiteClass
- 	^TestSuite
- 			!

Item was removed:
- ----- Method: TestCase class>>sunitVersion (in category 'accessing') -----
- sunitVersion
- 	^'3.1'
- 			!

Item was removed:
- ----- Method: TestCase class>>testSelectors (in category 'accessing') -----
- testSelectors
- 
- 	^(self selectors asArray select: [ :each | 
- 		(each beginsWith: 'test') and: [ each numArgs isZero ] ]) sort!

Item was removed:
- ----- Method: TestCase>>addDependentToHierachy: (in category 'dependencies') -----
- addDependentToHierachy: anObject 
- 	"an empty method. for Composite compability with TestSuite"
- 
- 
- 			!

Item was removed:
- ----- Method: TestCase>>assert: (in category 'asserting') -----
- assert: aBooleanOrBlock
- 
- 	aBooleanOrBlock value ifFalse: [self signalFailure: 'Assertion failed']
- 			!

Item was removed:
- ----- Method: TestCase>>assert:description: (in category 'asserting') -----
- assert: aBooleanOrBlock description: aStringOrBlock
- 
- 	aBooleanOrBlock value ifFalse: [
- 		| description |
- 		description := aStringOrBlock value.
- 		self logFailure: description.
- 		TestResult failure signal: description ]
- 			!

Item was removed:
- ----- Method: TestCase>>assert:description:resumable: (in category 'asserting') -----
- assert: aBooleanOrBlock description: aString resumable: resumableBoolean 
- 	| exception |
- 	aBooleanOrBlock value
- 		ifFalse: 
- 			[self logFailure: aString.
- 			exception := resumableBoolean
- 						ifTrue: [TestResult resumableFailure]
- 						ifFalse: [TestResult failure].
- 			exception signal: aString]
- 			!

Item was removed:
- ----- Method: TestCase>>assert:equals: (in category 'asserting') -----
- assert: expected equals: actual
- 
- 	^ self
- 		assert: expected
- 		equals: actual
- 		description: nil
- !

Item was removed:
- ----- Method: TestCase>>assert:equals:description: (in category 'asserting') -----
- assert: expected equals: actual description: aStringOrBlock
- 
- 	^ self
- 		assert: expected = actual
- 		description: [self
- 			failureDescription: aStringOrBlock
- 			with: (self comparingStringBetween: expected and: actual)]!

Item was removed:
- ----- Method: TestCase>>assert:identical: (in category 'asserting') -----
- assert: expected identical: actual
- 
- 	^ self
- 		assert: expected
- 		identical: actual
- 		description: nil!

Item was removed:
- ----- Method: TestCase>>assert:identical:description: (in category 'asserting') -----
- assert: expected identical: actual description: aStringOrBlock
- 
- 	^ self
- 		assert: expected == actual
- 		description: [self
- 			failureDescription: aStringOrBlock
- 			with: (self comparingStringBetween: expected andIdentical: actual)]!

Item was removed:
- ----- Method: TestCase>>assureResourcesDuring: (in category 'private') -----
- assureResourcesDuring: aBlock
- 
- 	| resources |
- 	resources := self resources.
- 	resources do: [:resource |
- 		resource isAvailable ifFalse: [
- 			resource signalInitializationError]].
- 	^ aBlock ensure: [
- 		resources do: [:resource |
- 			resource reset]].!

Item was removed:
- ----- Method: TestCase>>comparingStringBetween:and: (in category 'private') -----
- comparingStringBetween: expected and: actual
- 
- 	^ 'Expected {1} but was {2}.' translated
- 		format: {
- 			expected printStringLimitedTo: 10.
- 			actual printStringLimitedTo: 10 }!

Item was removed:
- ----- Method: TestCase>>comparingStringBetween:andIdentical: (in category 'private') -----
- comparingStringBetween: expected andIdentical: actual
- 
- 	^ 'Expected {1} and actual {2} are not identical.' translated
- 		format: {
- 			expected printStringLimitedTo: 10.
- 			actual printStringLimitedTo: 10 }!

Item was removed:
- ----- Method: TestCase>>comparingStringBetweenUnexpected:and: (in category 'private') -----
- comparingStringBetweenUnexpected: unexpected and: actual
- 
- 	^ 'Did not expect {1} but was {2}.' translated
- 		format: {
- 			unexpected printStringLimitedTo: 10.
- 			actual printStringLimitedTo: 10 }!

Item was removed:
- ----- Method: TestCase>>comparingStringBetweenUnexpected:andIdentical: (in category 'private') -----
- comparingStringBetweenUnexpected: expected andIdentical: actual
- 
- 	^ 'Unexpected {1} and actual {2} are identical.' translated
- 		format: {
- 			expected printStringLimitedTo: 10.
- 			actual printStringLimitedTo: 10 }!

Item was removed:
- ----- Method: TestCase>>debug (in category 'running') -----
- debug
- 	"Run the receiver and open a debugger on the first failure or error."
- 
- 	^ self assureResourcesDuring: [self runCaseWithoutTimeout]!

Item was removed:
- ----- Method: TestCase>>debugAsFailure (in category 'running') -----
- debugAsFailure
- 	"Spawn a debugger that is ready to debug the receiver."
- 
- 	(Process
- 		forBlock: [self debug]
- 		runUntil: [:context | context isClosureContext "navigate the process directly to the point where it is about to send #setUp"
- 			and: [context selector = #runCaseWithoutTimeout]])
- 				debug.!

Item was removed:
- ----- Method: TestCase>>defaultTimeout (in category 'running - timeout') -----
- defaultTimeout
- 	"Answer the default timeout to use for tests in this test case.
- 	The timeout is a value in seconds."
- 
- 	^Smalltalk isLowerPerformance ifTrue:[ 25] ifFalse: [5] "seconds"!

Item was removed:
- ----- Method: TestCase>>deny: (in category 'asserting') -----
- deny: aBooleanOrBlock
- 
- 	self assert: aBooleanOrBlock value not
- 			!

Item was removed:
- ----- Method: TestCase>>deny:description: (in category 'asserting') -----
- deny: aBooleanOrBlock description: aString
- 	self assert: aBooleanOrBlock value not description: aString
- 			!

Item was removed:
- ----- Method: TestCase>>deny:description:resumable: (in category 'asserting') -----
- deny: aBooleanOrBlock description: aString resumable: resumableBoolean 
- 	self
- 		assert: aBooleanOrBlock value not
- 		description: aString
- 		resumable: resumableBoolean
- 			!

Item was removed:
- ----- Method: TestCase>>deny:equals: (in category 'asserting') -----
- deny: unexpected equals: actual
- 
- 	^ self
- 		deny: unexpected
- 		equals: actual
- 		description: nil!

Item was removed:
- ----- Method: TestCase>>deny:equals:description: (in category 'asserting') -----
- deny: unexpected equals: actual description: aStringOrBlock
- 
- 	^ self
- 		deny: unexpected = actual
- 		description: [self
- 			failureDescription: aStringOrBlock
- 			with: (self comparingStringBetweenUnexpected: unexpected and: actual)]!

Item was removed:
- ----- Method: TestCase>>deny:identical: (in category 'asserting') -----
- deny: unexpected identical: actual
- 
- 	^ self
- 		deny: unexpected
- 		identical: actual
- 		description: nil!

Item was removed:
- ----- Method: TestCase>>deny:identical:description: (in category 'asserting') -----
- deny: unexpected identical: actual description: aStringOrBlock
- 
- 	^ self
- 		deny: unexpected == actual
- 		description: [self
- 			failureDescription: aStringOrBlock
- 			with: (self comparingStringBetweenUnexpected: unexpected andIdentical: actual)]!

Item was removed:
- ----- Method: TestCase>>ensureInternetConnection (in category 'asserting - extensions') -----
- ensureInternetConnection
- 
- 	^ self ensureInternetConnectionTo: 'http://www.google.com'!

Item was removed:
- ----- Method: TestCase>>ensureInternetConnectionTo: (in category 'asserting - extensions') -----
- ensureInternetConnectionTo: url 
- 
- 	"(Smalltalk classNamed: 'WebClient') httpGet: 'http://www.google.com'"
- 	((Smalltalk classNamed: 'WebClient') httpGet: url) isSuccess
- 		ifFalse: [Error signal: 'No internet connection available, but test requires one']
- 		!

Item was removed:
- ----- Method: TestCase>>ensureSecureInternetConnection (in category 'asserting - extensions') -----
- ensureSecureInternetConnection
- 
- 	^ self ensureInternetConnectionTo: 'https://www.google.com'!

Item was removed:
- ----- Method: TestCase>>executeShould:inScopeOf: (in category 'private') -----
- executeShould: aBlock inScopeOf: anExceptionalEvent 
- 	^[aBlock value.
-  	false] on: anExceptionalEvent
- 		do: [:ex | ex return: true]
- 			!

Item was removed:
- ----- Method: TestCase>>executeShould:inScopeOf:withDescriptionContaining: (in category 'private') -----
- executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: aString
- 	^[aBlock value.
-  	false] on: anExceptionalEvent
- 		do: [:ex | ex return: (ex description includesSubstring: aString) ]
- 			!

Item was removed:
- ----- Method: TestCase>>executeShould:inScopeOf:withDescriptionNotContaining: (in category 'private') -----
- executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: aString
- 	^[aBlock value.
-  	false] on: anExceptionalEvent
- 		do: [:ex | ex return: (ex description includesSubstring: aString) not ]
- 			!

Item was removed:
- ----- Method: TestCase>>executeShould:inScopeOf:withExceptionDo: (in category 'asserting - extensions') -----
- executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock
- 
- 	^[aBlock value.
-  	false] 
- 		on: anException
- 		do: [:exception | 
- 			anotherBlock value: exception.
- 			exception return: true]!

Item was removed:
- ----- Method: TestCase>>expectedFailures (in category 'failures') -----
- expectedFailures
- 	^ Array new!

Item was removed:
- ----- Method: TestCase>>fail (in category 'asserting - extensions') -----
- fail
- 
- 	^self assert: false!

Item was removed:
- ----- Method: TestCase>>fail: (in category 'asserting - extensions') -----
- fail: aString
- 
- 	^self assert: false description: aString.!

Item was removed:
- ----- Method: TestCase>>failureDescription:with: (in category 'private') -----
- failureDescription: aStringOrBlock with: reason
- 
- 	| description |
- 	description := aStringOrBlock value.
- 	^ description
- 		ifNil: [reason]
- 		ifNotNil: ['{1}: {2}' format: {description. reason}]!

Item was removed:
- ----- Method: TestCase>>failureLog (in category 'running') -----
- failureLog	
- 	^Transcript
- 
- 			!

Item was removed:
- ----- Method: TestCase>>isInstalled (in category 'testing') -----
- isInstalled
- 
- 	^ self respondsTo: testSelector!

Item was removed:
- ----- Method: TestCase>>isLogging (in category 'running') -----
- isLogging
- 	"By default, we're not logging failures. If you override this in 
- 	a subclass, make sure that you override #failureLog"
- 	^false
- 			!

Item was removed:
- ----- Method: TestCase>>logFailure: (in category 'running') -----
- logFailure: aString
- 	self isLogging ifTrue: [
- 		self failureLog 
- 			cr; 
- 			nextPutAll: aString; 
- 			flush]
- 			!

Item was removed:
- ----- Method: TestCase>>performTest (in category 'private') -----
- performTest
- 
- 	self perform: testSelector asSymbol
- 			!

Item was removed:
- ----- Method: TestCase>>printOn: (in category 'printing') -----
- printOn: aStream
- 
- 	testSelector
- 		ifNil: [super printOn: aStream]
- 		ifNotNil:
- 			[aStream
- 				nextPutAll: self class printString;
- 				nextPutAll: '>>#';
- 				nextPutAll: testSelector]	!

Item was removed:
- ----- Method: TestCase>>removeDependentFromHierachy: (in category 'dependencies') -----
- removeDependentFromHierachy: anObject 
- 	"an empty method. for Composite compability with TestSuite"
- 
- 
- 			!

Item was removed:
- ----- Method: TestCase>>resources (in category 'accessing') -----
- 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
- 			!

Item was removed:
- ----- Method: TestCase>>run (in category 'running') -----
- run
- 	| result |
- 	result := TestResult new.
- 	self run: result.
- 	^result
- 			!

Item was removed:
- ----- Method: TestCase>>run: (in category 'running') -----
- run: aResult 
- 	aResult runCase: self.
- !

Item was removed:
- ----- Method: TestCase>>runCase (in category 'running') -----
- runCase
- 	"Run this TestCase. Time out if the test takes too long."
- 
- 	[self timeout: [self setUp]
- 		after: self timeoutForSetUp.
- 	self timeout: [self performTest]
- 		after: self timeoutForTest]
- 		ensure: [self tearDown]!

Item was removed:
- ----- Method: TestCase>>runCaseWithoutTimeout (in category 'running') -----
- runCaseWithoutTimeout
- 
- 	[self setUp.
- 	self performTest]
- 		ensure: [self tearDown].!

Item was removed:
- ----- Method: TestCase>>selector (in category 'accessing') -----
- selector
- 	^testSelector
- 			!

Item was removed:
- ----- Method: TestCase>>setTestSelector: (in category 'private') -----
- setTestSelector: aSymbol
- 	testSelector := aSymbol
- 			!

Item was removed:
- ----- Method: TestCase>>setUp (in category 'running') -----
- setUp!

Item was removed:
- ----- Method: TestCase>>should: (in category 'asserting') -----
- should: aBlock
- 	self assert: aBlock value
- 			!

Item was removed:
- ----- Method: TestCase>>should:description: (in category 'asserting') -----
- should: aBlock description: aString
- 	self assert: aBlock value description: aString
- 			!

Item was removed:
- ----- Method: TestCase>>should:notTakeMoreThan: (in category 'asserting - extensions') -----
- should: aBlock notTakeMoreThan: aDuration
-     "Evaluate aBlock in a forked process and if it takes more than anInteger milliseconds
-     to run we terminate the process and report a test failure.  It'' important to
-     use the active process for the test failure so that the failure reporting works correctly
-     in the context of the exception handlers."
- 
-     | evaluated evaluationProcess result delay testProcess |
- 
-     evaluated := false.
-     delay := Delay forDuration: aDuration.
-     testProcess := Processor activeProcess.
-     "Create a new process to evaluate aBlock"
-     evaluationProcess := [
-         result := aBlock value.
-         evaluated := true.
-         delay unschedule.
-         testProcess resume ] forkNamed: 'Process to evaluate should: notTakeMoreThanMilliseconds:'.
- 
-     "Wait the milliseconds they asked me to"
-     delay wait.
-     "After this point either aBlock was evaluated or not..."
-     evaluated ifFalse: [
-         evaluationProcess terminate.
-         self assert: false description: ('Block evaluation took more than the expected <1p>' expandMacrosWith: aDuration)].
-    
-     ^result!

Item was removed:
- ----- Method: TestCase>>should:notTakeMoreThanMilliseconds: (in category 'asserting - extensions') -----
- should: aBlock notTakeMoreThanMilliseconds: anInteger
-     "For compatibility with other Smalltalks"
- 
-    self should: aBlock notTakeMoreThan: (Duration milliSeconds: anInteger).!

Item was removed:
- ----- Method: TestCase>>should:raise: (in category 'asserting') -----
- should: aBlock raise: anExceptionalEvent 
- 	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
- 			!

Item was removed:
- ----- Method: TestCase>>should:raise:description: (in category 'asserting') -----
- should: aBlock raise: anExceptionalEvent description: aString 
- 	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
- 		description: aString
- 			!

Item was removed:
- ----- Method: TestCase>>should:raise:whoseDescriptionDoesNotInclude:description: (in category 'asserting') -----
- should: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString 
- 	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString)
- 		description: aString
- !

Item was removed:
- ----- Method: TestCase>>should:raise:whoseDescriptionIncludes:description: (in category 'asserting') -----
- should: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString 
- 	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString)
- 		description: aString
- !

Item was removed:
- ----- Method: TestCase>>should:raise:withExceptionDo: (in category 'asserting - extensions') -----
- should: aBlock raise: anException withExceptionDo: anotherBlock 
- 
- 	^self assert: (self executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock)!

Item was removed:
- ----- Method: TestCase>>shouldPass (in category 'testing') -----
- shouldPass
- 	"Unless the selector is in the list we get from #expectedFailures, we expect it to pass"
- 	^ (self expectedFailures includes: testSelector) not!

Item was removed:
- ----- Method: TestCase>>shouldRaiseError: (in category 'asserting') -----
- shouldRaiseError: aBlock
- 
- 	^ self should: aBlock raise: TestResult exError
- 			!

Item was removed:
- ----- Method: TestCase>>shouldnt: (in category 'asserting') -----
- shouldnt: aBlock
- 	self deny: aBlock value
- 			!

Item was removed:
- ----- Method: TestCase>>shouldnt:description: (in category 'asserting') -----
- shouldnt: aBlock description: aString
- 	self deny: aBlock value description: aString
- 			!

Item was removed:
- ----- Method: TestCase>>shouldnt:raise: (in category 'asserting') -----
- shouldnt: aBlock raise: anExceptionalEvent 
- 	^ [ aBlock value ]
- 		on: anExceptionalEvent
- 		do: [:e | self fail: 'Block raised ', e className, ': ', e messageText].!

Item was removed:
- ----- Method: TestCase>>shouldnt:raise:description: (in category 'asserting') -----
- shouldnt: aBlock raise: anExceptionalEvent description: aString 
- 	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not 		description: aString
- 			!

Item was removed:
- ----- Method: TestCase>>shouldnt:raise:whoseDescriptionDoesNotInclude:description: (in category 'asserting') -----
- shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString 
- 	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString) not
- 		description: aString
- !

Item was removed:
- ----- Method: TestCase>>shouldnt:raise:whoseDescriptionIncludes:description: (in category 'asserting') -----
- shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString 
- 	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString) not
- 		description: aString
- !

Item was removed:
- ----- Method: TestCase>>signalFailure: (in category 'private') -----
- signalFailure: aString
- 	TestResult failure signal: aString!

Item was removed:
- ----- Method: TestCase>>tearDown (in category 'running') -----
- tearDown!

Item was removed:
- ----- Method: TestCase>>timeout: (in category 'running - timeout') -----
- timeout: seconds
- 	"The timeout for a test should normally be set with a method annotation.
- 	However, for tests that are expected to run in images that do not support
- 	method annotations, the value may be set by setting the value from the
- 	#setUp method (i.e. prior to running the test method)."
- 
- 	timeout := seconds!

Item was removed:
- ----- Method: TestCase>>timeout:after: (in category 'private') -----
- timeout: aBlock after: seconds
- 	"Evaluate the argument block. Time out if the evaluation is not
- 	complete after the given number of seconds. Handle the situation
- 	that a timeout may occur after a failure (during debug)"
- 
- 	| theProcess delay watchdog |
- 
- 	"the block will be executed in the current process"
- 	theProcess := Processor activeProcess.
- 	delay := Delay forSeconds: seconds.
- 
- 	"make a watchdog process"
- 	watchdog := [
- 		delay wait. 	"wait for timeout or completion"
- 		theProcess ifNotNil:[ theProcess signalException: 
- 			(TestFailure new messageText: 'Test timed out' translated) ] 
- 	] newProcess.
- 
- 	"Watchdog needs to run at high priority to do its job (but not at timing priority)"
- 	watchdog priority: Processor timingPriority-1.
- 
- 	"catch the timeout signal"
- 	watchdog resume.				"start up the watchdog"
- 	^[aBlock on: TestFailure, TestResult allErrors do: [:ex|
- 		theProcess := nil.
- 		ex pass.
- 	]] ensure:[							"evaluate the receiver"
- 		theProcess := nil.				"it has completed, so ..."
- 		delay delaySemaphore signal.	"arrange for the watchdog to exit"
- 	]!

Item was removed:
- ----- Method: TestCase>>timeoutForSetUp (in category 'running - timeout') -----
- timeoutForSetUp
- 	"Answer the timeout to use for setUp"
- 
- 	| method |
- 	method := self class lookupSelector: testSelector asSymbol.
- 	(method pragmaAt: #timeout:) ifNotNil:[:tag| ^tag arguments first].
- 	^self defaultTimeout!

Item was removed:
- ----- Method: TestCase>>timeoutForTest (in category 'running - timeout') -----
- timeoutForTest
- 	"Answer the timeout to use for this test"
- 
- 	| method |
- 	method := self class lookupSelector: testSelector asSymbol.
- 	(method pragmaAt: #timeout:) ifNotNil:[:tag| ^tag arguments first].
- 	^timeout ifNil: [self defaultTimeout]!

Item was removed:
- Exception subclass: #TestFailure
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Kernel'!
- 
- !TestFailure commentStamp: '<historical>' prior: 0!
- Signaled in case of a failed test (failure). The test framework distinguishes between failures and errors. A failure is anticipated and checked for with assertions. Errors are unanticipated problems like a division by 0 or an index out of bounds ...!

Item was removed:
- ----- Method: TestFailure>>defaultAction (in category 'camp smalltalk') -----
- defaultAction
- 
- 	^ Processor
- 		debugContext: self signalerContext
- 		title: self description
- 		full: false
- 		contents: nil!

Item was removed:
- ----- Method: TestFailure>>isResumable (in category 'camp smalltalk') -----
- isResumable
- 	
- 	^ false!

Item was removed:
- Object subclass: #TestResource
- 	instanceVariableNames: 'name description'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Kernel'!
- TestResource class
- 	instanceVariableNames: 'current'!
- 
- !TestResource commentStamp: 'pre 10/26/2020 17:11' prior: 0!
- A TestResource represents a resource required for tests that is time consuming / difficult to setup AND does not break test isolation, i.e. it can be reused across tests within one suite.
- 
- To define your own test resource, subclass from TestResource. The most important method to implement is #setUp, where you can define how the test resource is to be initialized. You can store arbitrary state here. Analogously, you can release relevant state in the #tearDown method.
- 
- If you want to have a test resource available for a suite, implement the method #resources on the class side of your TestCase subclass. You can then access your resource by calling #current on your TestResource subclass.!
- TestResource class
- 	instanceVariableNames: 'current'!

Item was removed:
- ----- Method: TestResource class>>cleanUp: (in category 'class initialization') -----
- cleanUp: aggressive
- 
- 	aggressive ifTrue: [
- 		self withAllSubclassesDo: [:cls | cls reset]].!

Item was removed:
- ----- Method: TestResource class>>current (in category 'accessing') -----
- current
- 	^ current ifNil: [ current := self new]
- 			!

Item was removed:
- ----- Method: TestResource class>>current: (in category 'accessing') -----
- current: aTestResource
- 
- 	current := aTestResource
- 			!

Item was removed:
- ----- Method: TestResource class>>isAbstract (in category 'testing') -----
- isAbstract
- 	"Override to true if a TestResource subclass is Abstract and should not have
- 	TestCase instances built from it"
- 
- 	^self name = #TestResource
- 			!

Item was removed:
- ----- Method: TestResource class>>isAvailable (in category 'testing') -----
- isAvailable
- 	^self current notNil and: [self current isAvailable]
- 			!

Item was removed:
- ----- Method: TestResource class>>isUnavailable (in category 'testing') -----
- isUnavailable
- 
- 	^self isAvailable not
- 			!

Item was removed:
- ----- Method: TestResource class>>reset (in category 'Creation') -----
- reset
- 	current ifNotNil: [:oldCurrent |
- 		current := nil.
- 		oldCurrent tearDown]!

Item was removed:
- ----- Method: TestResource class>>resources (in category 'accessing') -----
- resources
- 	^#()
- 			!

Item was removed:
- ----- Method: TestResource class>>signalInitializationError (in category 'creation') -----
- signalInitializationError
- 	^TestResult signalErrorWith: 'Resource ' , self name , ' could not be initialized'
- 			!

Item was removed:
- ----- Method: TestResource>>description (in category 'accessing') -----
- description
- 
- 	^description ifNil: [ '' ]!

Item was removed:
- ----- Method: TestResource>>description: (in category 'accessing') -----
- description: aString
- 
- 	description := aString
- 			!

Item was removed:
- ----- Method: TestResource>>initialize (in category 'initializing') -----
- initialize
- 	super initialize.
- 	self setUp
- 
- 			!

Item was removed:
- ----- Method: TestResource>>isAvailable (in category 'testing') -----
- isAvailable
- 	"override to provide information on the
- 	readiness of the resource"
- 	
- 	^true
- 			!

Item was removed:
- ----- Method: TestResource>>isUnavailable (in category 'testing') -----
- isUnavailable
- 	"override to provide information on the
- 	readiness of the resource"
- 	
- 	^self isAvailable not
- 			!

Item was removed:
- ----- Method: TestResource>>name (in category 'accessing') -----
- name
- 
- 	^name ifNil: [ self printString]!

Item was removed:
- ----- Method: TestResource>>name: (in category 'accessing') -----
- name: aString
- 
- 	name := aString
- 			!

Item was removed:
- ----- Method: TestResource>>printOn: (in category 'printing') -----
- printOn: aStream
- 
- 	aStream nextPutAll: self class printString
- 			!

Item was removed:
- ----- Method: TestResource>>resources (in category 'accessing') -----
- resources
- 	^self class resources
- 			!

Item was removed:
- ----- Method: TestResource>>setUp (in category 'running') -----
- setUp
- 	"Does nothing. Subclasses should override this
- 	to initialize their resource"
- 			!

Item was removed:
- ----- Method: TestResource>>signalInitializationError (in category 'running') -----
- signalInitializationError
- 	^self class signalInitializationError
- 			!

Item was removed:
- ----- Method: TestResource>>tearDown (in category 'running') -----
- tearDown
- 	"Does nothing. Subclasses should override this
- 	to tear down their resource"
- 			!

Item was removed:
- Object subclass: #TestResult
- 	instanceVariableNames: 'timeStamp failures errors passed durations'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Kernel'!
- 
- !TestResult commentStamp: '<historical>' prior: 0!
- 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.!

Item was removed:
- ----- Method: TestResult class>>allErrors (in category 'exceptions') -----
- allErrors
- 	"Answer an exception set for all common exceptions that can be raised when a typical error is detected in Squeak. This method decouples the testing framework from the exception handling system and allows clients to convert their tests to another Smalltalk dialect easily."
- 	^ self exError, Warning, Halt
- 			!

Item was removed:
- ----- Method: TestResult class>>error (in category 'exceptions') -----
- error
- 
- 	self deprecated: 'ct: Send #exError to retrieve an exception class or #error: to signal an error, depending on what you need.'.
- 	^ super error!

Item was removed:
- ----- Method: TestResult class>>exError (in category 'exceptions') -----
- exError
- 	"Answer the exception class that represents a regular error in Squeak. This method decouples the testing framework from the exception handling system and allows clients to convert their tests to another Smalltalk dialect easily."
- 	^Error
- 			!

Item was removed:
- ----- Method: TestResult class>>failure (in category 'exceptions') -----
- failure
- 	^TestFailure
- 			!

Item was removed:
- ----- Method: TestResult class>>historyAt: (in category 'history') -----
- historyAt: aTestCaseClass
- "I will return the last test dictionary for aTestCaseClass. If none found, I will create a new empty one and link it in the history."
- 
- 	^ aTestCaseClass history !

Item was removed:
- ----- Method: TestResult class>>historyAt:put: (in category 'history') -----
- historyAt: aTestCaseClass put: aDictionary
- 	aTestCaseClass history: aDictionary
- 	"^ self history at: aTestCaseClass put: aDictionary "!

Item was removed:
- ----- Method: TestResult class>>historyFor: (in category 'history') -----
- historyFor: aTestCaseClass
- 	"I return the last test dictionary for aTestCaseClass. 
- 	If none found, I return an empty dictionary but will not link it to the class in the history."
- 	
- 	| history |
- 	history := aTestCaseClass history.
- 	history ifNil: [ ^ self newTestDictionary ].
- 	^ history
- 	
- "	^ self history at: aTestCaseClass ifAbsent: [ self newTestDictionary ]"!

Item was removed:
- ----- Method: TestResult class>>newTestDictionary (in category 'history') -----
- newTestDictionary
- 
- 	^ Dictionary new at: #timeStamp put: TimeStamp now;
- 		at: #passed put: Set new;
- 		at: #failures put: Set new;
- 		at: #errors put: Set new;
- 		yourself
- 		!

Item was removed:
- ----- Method: TestResult class>>removeFromTestHistory:in: (in category 'history') -----
- removeFromTestHistory: aSelector in: aTestCaseClass
- 	| lastRun |
- 	
- 	lastRun := self historyFor: aTestCaseClass.
- 	#(#passed #failures #errors) do:
- 		[ :set | (lastRun at: set) remove: aSelector ifAbsent: []].
- !

Item was removed:
- ----- Method: TestResult class>>resumableFailure (in category 'exceptions') -----
- resumableFailure
- 	^ResumableTestFailure
- 			!

Item was removed:
- ----- Method: TestResult class>>signalErrorWith: (in category 'exceptions') -----
- signalErrorWith: aString 
- 	^ self exError signal: aString!

Item was removed:
- ----- Method: TestResult class>>signalFailureWith: (in category 'exceptions') -----
- signalFailureWith: aString 
- 	self failure signal: aString
- 			!

Item was removed:
- ----- Method: TestResult class>>updateTestHistoryFor:status: (in category 'history') -----
- updateTestHistoryFor: aTestCase status: aSymbol
- 	| cls sel |
- 	
- 	cls := aTestCase class.
- 	sel := aTestCase selector.
- 	self removeFromTestHistory: sel in: cls.
- 	((self historyAt: cls) at: aSymbol ) add: sel!

Item was removed:
- ----- Method: TestResult>>classesTested (in category 'accessing') -----
- classesTested
- 	^ (self tests collect: [ :testCase | testCase class ]) asSet!

Item was removed:
- ----- Method: TestResult>>correctCount (in category 'accessing') -----
- correctCount
- 	"depreciated - use #passedCount"
- 
- 	^self passedCount
- 			!

Item was removed:
- ----- Method: TestResult>>defects (in category 'accessing') -----
- defects
- 	^OrderedCollection new
- 		addAll: self errors;
- 		addAll: self failures; yourself
- 			!

Item was removed:
- ----- Method: TestResult>>diff: (in category 'diff') -----
- diff: aTestResult
- 	"Return a collection that contains differences"
- 	| passed1Selectors failed1Selectors errors1Selectors passed2Selectors failed2Selectors errors2Selectors |
- 	passed1Selectors := self passed collect: [:testCase | testCase selector].
- 	failed1Selectors := self failures collect: [:testCase | testCase selector].
- 	errors1Selectors := self errors collect: [:testCase | testCase selector].
- 
- 	passed2Selectors := aTestResult passed collect: [:testCase | testCase selector].
- 	failed2Selectors := aTestResult failures collect: [:testCase | testCase selector].
- 	errors2Selectors := aTestResult errors collect: [:testCase | testCase selector].
- 	
- 	^ {passed1Selectors copyWithoutAll: passed2Selectors .
- 		failed1Selectors copyWithoutAll: failed2Selectors .
- 		errors1Selectors copyWithoutAll: errors2Selectors}!

Item was removed:
- ----- Method: TestResult>>dispatchResultsIntoHistory (in category 'history') -----
- dispatchResultsIntoHistory 
- 
- 	self classesTested do: 
- 		[ :testClass | 
- 		self class
- 			historyAt: testClass
- 			put: (self selectResultsForTestCase: testClass) ].
- !

Item was removed:
- ----- Method: TestResult>>duration (in category 'accessing') -----
- duration
- 
- 	^ self durations inject: 0 into: [:sum :each | sum + (each ifNil: [0])]!

Item was removed:
- ----- Method: TestResult>>durations (in category 'accessing') -----
- durations
- 	^ durations!

Item was removed:
- ----- Method: TestResult>>errorCount (in category 'accessing') -----
- errorCount
- 
- 	^self errors size
- 			!

Item was removed:
- ----- Method: TestResult>>errors (in category 'compatibility') -----
- errors
- 	^ self unexpectedErrors!

Item was removed:
- ----- Method: TestResult>>expectedDefectCount (in category 'accessing') -----
- expectedDefectCount
- 	^ self expectedDefects size!

Item was removed:
- ----- Method: TestResult>>expectedDefects (in category 'accessing') -----
- expectedDefects
- 	^ (errors, failures asOrderedCollection) select: [:each | each shouldPass not] !

Item was removed:
- ----- Method: TestResult>>expectedPassCount (in category 'accessing') -----
- expectedPassCount
- 	^ self expectedPasses size!

Item was removed:
- ----- Method: TestResult>>expectedPasses (in category 'accessing') -----
- expectedPasses
- 	^ passed select: [:each | each shouldPass] !

Item was removed:
- ----- Method: TestResult>>failureCount (in category 'accessing') -----
- failureCount
- 
- 	^self failures size
- 			!

Item was removed:
- ----- Method: TestResult>>failures (in category 'compatibility') -----
- failures
- 	^ self unexpectedFailures, self unexpectedPasses !

Item was removed:
- ----- Method: TestResult>>hasErrors (in category 'testing') -----
- hasErrors
- 
- 	^self errors size > 0
- 			!

Item was removed:
- ----- Method: TestResult>>hasFailures (in category 'testing') -----
- hasFailures
- 
- 	^self failures size > 0
- 			!

Item was removed:
- ----- Method: TestResult>>hasPassed (in category 'testing') -----
- hasPassed
- 	^ self hasErrors not and: [ self hasFailures not ]!

Item was removed:
- ----- Method: TestResult>>initialize (in category 'initialization') -----
- initialize
- 	super initialize.
- 	passed := OrderedCollection new.
- 	failures := Set new.
- 	errors := OrderedCollection new.
- 	timeStamp := TimeStamp now.
- 	durations := Dictionary new.!

Item was removed:
- ----- Method: TestResult>>isError: (in category 'testing') -----
- isError: aTestCase
- 
- 	^self errors includes: aTestCase
- 			!

Item was removed:
- ----- Method: TestResult>>isErrorFor:selector: (in category 'querying') -----
- isErrorFor: class selector: selector
- 	^ self errors anySatisfy: [:testCase | testCase class == class and: [testCase selector == selector]]!

Item was removed:
- ----- Method: TestResult>>isFailure: (in category 'testing') -----
- isFailure: aTestCase
- 	^self failures includes: aTestCase
- 			!

Item was removed:
- ----- Method: TestResult>>isFailureFor:selector: (in category 'querying') -----
- isFailureFor: class selector: selector
- 	^ self failures anySatisfy: [:testCase | testCase class == class and: [testCase selector == selector]]!

Item was removed:
- ----- Method: TestResult>>isPassed: (in category 'testing') -----
- isPassed: aTestCase
- 
- 	^self passed includes: aTestCase
- 			!

Item was removed:
- ----- Method: TestResult>>isPassedFor:selector: (in category 'querying') -----
- isPassedFor: class selector: selector
- 	^ self passed anySatisfy: [:testCase | testCase class == class and: [testCase selector == selector]]!

Item was removed:
- ----- Method: TestResult>>passed (in category 'compatibility') -----
- passed
- 	^ self expectedPasses, self expectedDefects!

Item was removed:
- ----- Method: TestResult>>passedCount (in category 'accessing') -----
- passedCount
- 
- 	^self passed size
- 			!

Item was removed:
- ----- Method: TestResult>>printOn: (in category 'printing') -----
- printOn: aStream
- 	aStream
- 		nextPutAll: self runCount printString;
- 		nextPutAll: ' run in ';
- 		nextPutAll: (Duration milliSeconds: self duration) printString;
- 		nextPutAll: ', ';
- 		nextPutAll: self expectedPassCount printString;
- 		nextPutAll: ' passes, ';
- 		nextPutAll: self expectedDefectCount printString;
- 		nextPutAll:' expected failures, ';
- 		nextPutAll: self unexpectedFailureCount printString;
- 		nextPutAll: ' failures, ';
- 		nextPutAll: self unexpectedErrorCount printString;
- 		nextPutAll:' errors, ';
- 		nextPutAll: self unexpectedPassCount printString;
- 		nextPutAll:' unexpected passes'.!

Item was removed:
- ----- Method: TestResult>>resetErrors (in category 'initialization') -----
- resetErrors
- 	"clear the errors list ready to re-run those tests"
- 
- 	errors := OrderedCollection new!

Item was removed:
- ----- Method: TestResult>>resetFailures (in category 'initialization') -----
- resetFailures
- 	"clear the failures list ready to re-run those tests"
- 
- 	failures := Set new!

Item was removed:
- ----- Method: TestResult>>runCase: (in category 'running') -----
- runCase: aTestCase
- 	
- 	| testCasePassed timeToRun |
- 	testCasePassed := true.
- 
- 	[timeToRun := [aTestCase runCase] timeToRunWithoutGC] 
- 		on: self class failure
- 		do: [:signal | 
- 				failures add: aTestCase.
- 				testCasePassed := false.
- 				signal return: false]
- 		on: self class allErrors
- 		do: [:signal |
- 				errors add: aTestCase.
- 				testCasePassed := false.
- 				signal return: false].
- 			
- 	testCasePassed ifTrue: [passed add: aTestCase].
- 	self durations at: aTestCase put: timeToRun.!

Item was removed:
- ----- Method: TestResult>>runCount (in category 'accessing') -----
- runCount
- 	^ passed size + failures size + errors size!

Item was removed:
- ----- Method: TestResult>>selectResultsForTestCase: (in category 'history') -----
- selectResultsForTestCase: aTestCaseClass
- 	| passedSelectors errorsSelectors failuresSelectors testCaseDurations |
- 	
- 	passedSelectors := self passed
- 						select: [:testCase | testCase class == aTestCaseClass ] thenCollect: [:testCase | testCase selector].
- 	errorsSelectors := self errors 
- 						select: [:testCase | testCase class == aTestCaseClass ] thenCollect:  [:testCase | testCase selector].
- 	failuresSelectors := self failures 
- 						select: [:testCase | testCase class == aTestCaseClass ] thenCollect:  [:testCase | testCase selector].
- 
- 	testCaseDurations := Dictionary new.
- 	self durations keysAndValuesDo: [:testCase :milliseconds |
- 		testCase class == aTestCaseClass ifTrue: [testCaseDurations at: testCase selector put: milliseconds]].		
- 
- 	^ self class newTestDictionary
- 		at: #timeStamp put: self timeStamp; "Keep this result's time stamp."
- 		at: #passed put: passedSelectors asSet;
- 		at: #failures put: failuresSelectors asSet;
- 		at: #errors put: errorsSelectors asSet;
- 		at: #durations put: testCaseDurations;
- 		at: #duration put: (testCaseDurations inject: 0 into: [:sum :each | sum + (each ifNil: [0])]);
- 		yourself
- 		!

Item was removed:
- ----- Method: TestResult>>tests (in category 'accessing') -----
- tests
- 	^(OrderedCollection new: self runCount)
- 		addAll: passed;
- 		addAll: failures;
- 		addAll: errors;
- 		yourself!

Item was removed:
- ----- Method: TestResult>>timeStamp (in category 'accessing') -----
- timeStamp
- 	^ timeStamp!

Item was removed:
- ----- Method: TestResult>>timeStamp: (in category 'accessing') -----
- timeStamp: anObject
- 	timeStamp := anObject!

Item was removed:
- ----- Method: TestResult>>unexpectedErrorCount (in category 'accessing') -----
- unexpectedErrorCount
- 	^ self unexpectedErrors size!

Item was removed:
- ----- Method: TestResult>>unexpectedErrors (in category 'accessing') -----
- unexpectedErrors
- 	^ errors select: [:each | each shouldPass] !

Item was removed:
- ----- Method: TestResult>>unexpectedFailureCount (in category 'accessing') -----
- unexpectedFailureCount
- 	^ self unexpectedFailures size!

Item was removed:
- ----- Method: TestResult>>unexpectedFailures (in category 'accessing') -----
- unexpectedFailures
- 	^ failures select: [:each | each shouldPass] !

Item was removed:
- ----- Method: TestResult>>unexpectedPassCount (in category 'accessing') -----
- unexpectedPassCount
- 	^ self unexpectedPasses size!

Item was removed:
- ----- Method: TestResult>>unexpectedPasses (in category 'accessing') -----
- unexpectedPasses
- 	^ passed select: [:each | each shouldPass not] !

Item was removed:
- ----- Method: TestResult>>updateResultsInHistory (in category 'history') -----
- updateResultsInHistory
- 	
- 	#(#passed #failures #errors) do: [ :status | 
- 		(self perform: status) do: [ :testCase | 
- 			self class updateTestHistoryFor: testCase status: status ] ]!

Item was removed:
- Object subclass: #TestSuite
- 	instanceVariableNames: 'tests resources name'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'SUnit-Kernel'!
- 
- !TestSuite commentStamp: '<historical>' prior: 0!
- This is a Composite of Tests, either TestCases or other TestSuites. The common protocol is #run: aTestResult and the dependencies protocol!

Item was removed:
- ----- Method: TestSuite class>>named: (in category 'instance creation') -----
- named: aString
- 
- 	^self new
- 		name: aString;
- 		yourself
- 			!

Item was removed:
- ----- Method: TestSuite>>addDependentToHierachy: (in category 'dependencies') -----
- addDependentToHierachy: anObject
- 	self addDependent: anObject.
- 	self tests do: [ :each | each addDependentToHierachy: anObject]
- 			!

Item was removed:
- ----- Method: TestSuite>>addTest: (in category 'accessing') -----
- addTest: aTest
- 	self tests add: aTest
- 			!

Item was removed:
- ----- Method: TestSuite>>addTests: (in category 'accessing') -----
- addTests: aCollection 
- 	aCollection do: [:eachTest | self addTest: eachTest]
- 			!

Item was removed:
- ----- Method: TestSuite>>debug (in category 'running') -----
- debug
- 	self tests do:
- 		[ : each | self changed: each.
- 		each debug ]!

Item was removed:
- ----- Method: TestSuite>>defaultResources (in category 'accessing') -----
- defaultResources
- 	^self tests 
- 		inject: Set new
- 		into: [:coll :testCase | 
- 			coll
- 				addAll: testCase resources;
- 				yourself]
- 			!

Item was removed:
- ----- Method: TestSuite>>name (in category 'accessing') -----
- name
- 
- 	^name
- 			!

Item was removed:
- ----- Method: TestSuite>>name: (in category 'accessing') -----
- name: aString
- 
- 	name := aString
- 			!

Item was removed:
- ----- Method: TestSuite>>removeDependentFromHierachy: (in category 'dependencies') -----
- removeDependentFromHierachy: anObject
- 	self removeDependent: anObject.
- 	self tests do: [ :each | each removeDependentFromHierachy: anObject]
- 			!

Item was removed:
- ----- Method: TestSuite>>resources (in category 'accessing') -----
- resources
- 	^ resources ifNil: [resources := self defaultResources]
- 			!

Item was removed:
- ----- Method: TestSuite>>resources: (in category 'accessing') -----
- resources: anObject
- 	resources := anObject
- 			!

Item was removed:
- ----- Method: TestSuite>>resultClass (in category 'private') -----
- resultClass
- 
- 	^ TestResult.!

Item was removed:
- ----- Method: TestSuite>>run (in category 'running') -----
- run
- 	| result |
-  	result := self resultClass new.
- 	self resources do: [ :res |
- 		res isAvailable ifFalse: [^res signalInitializationError]].
- 	[self run: result] ensure: [self resources do: [:each | each reset]].
- 	^result
- 			!

Item was removed:
- ----- Method: TestSuite>>run: (in category 'running') -----
- run: aResult 
- 	self tests do: [:each | 
- 		self changed: each.
- 		each run: aResult].
- 			!

Item was removed:
- ----- Method: TestSuite>>tests (in category 'accessing') -----
- tests
- 	^ tests ifNil: [tests := OrderedCollection new]
- 			!



More information about the Squeak-dev mailing list