[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
|