Patrick Rein uploaded a new version of SUnit to project The Trunk: http://source.squeak.org/trunk/SUnit-pre.122.mcz
==================== Summary ====================
Name: SUnit-pre.122 Author: pre Time: 24 August 2020, 3:13:32.049786 pm UUID: 6755fd5f-c8d9-b94b-b7ce-61cb56b0de2e Ancestors: SUnit-mt.121
Recateogrizes assertions and timeout infrastructure from the "accessing" category to their own method categories.
=============== Diff against SUnit-mt.121 ===============
Item was changed: + ----- Method: TestCase>>assert: (in category 'asserting') ----- - ----- Method: TestCase>>assert: (in category 'accessing') ----- assert: aBooleanOrBlock
aBooleanOrBlock value ifFalse: [self signalFailure: 'Assertion failed'] !
Item was changed: + ----- Method: TestCase>>assert:description: (in category 'asserting') ----- - ----- Method: TestCase>>assert:description: (in category 'accessing') ----- assert: aBooleanOrBlock description: aStringOrBlock
aBooleanOrBlock value ifFalse: [ | description | description := aStringOrBlock value. self logFailure: description. TestResult failure signal: description ] !
Item was changed: + ----- Method: TestCase>>assert:description:resumable: (in category 'asserting') ----- - ----- Method: TestCase>>assert:description:resumable: (in category 'accessing') ----- 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 changed: + ----- Method: TestCase>>assert:equals: (in category 'asserting') ----- - ----- Method: TestCase>>assert:equals: (in category 'accessing') ----- assert: expected equals: actual
^self assert: expected = actual description: [ self comparingStringBetween: expected and: actual ] !
Item was changed: + ----- Method: TestCase>>assert:equals:description: (in category 'asserting') ----- - ----- Method: TestCase>>assert:equals:description: (in category 'accessing') ----- assert: expected equals: actual description: aString
^self assert: expected = actual description: [ aString , ': ', (self comparingStringBetween: expected and: actual) ]!
Item was changed: + ----- Method: TestCase>>assert:identical: (in category 'asserting') ----- - ----- Method: TestCase>>assert:identical: (in category 'accessing') ----- assert: expected identical: actual
^self assert: expected == actual description: [ self comparingStringBetweenIdentical: expected and: actual ] !
Item was changed: + ----- Method: TestCase>>assert:identical:description: (in category 'asserting') ----- - ----- Method: TestCase>>assert:identical:description: (in category 'accessing') ----- assert: expected identical: actual description: aString
^self assert: expected == actual description: [ aString , ': ', (self comparingStringBetweenIdentical: expected and: actual) ]!
Item was changed: + ----- Method: TestCase>>defaultTimeout (in category 'running - timeout') ----- - ----- Method: TestCase>>defaultTimeout (in category 'accessing') ----- 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 changed: + ----- Method: TestCase>>deny: (in category 'asserting') ----- - ----- Method: TestCase>>deny: (in category 'accessing') ----- deny: aBooleanOrBlock
self assert: aBooleanOrBlock value not !
Item was changed: + ----- Method: TestCase>>deny:description: (in category 'asserting') ----- - ----- Method: TestCase>>deny:description: (in category 'accessing') ----- deny: aBooleanOrBlock description: aString self assert: aBooleanOrBlock value not description: aString !
Item was changed: + ----- Method: TestCase>>deny:description:resumable: (in category 'asserting') ----- - ----- Method: TestCase>>deny:description:resumable: (in category 'accessing') ----- deny: aBooleanOrBlock description: aString resumable: resumableBoolean self assert: aBooleanOrBlock value not description: aString resumable: resumableBoolean !
Item was changed: + ----- Method: TestCase>>deny:equals: (in category 'asserting') ----- - ----- Method: TestCase>>deny:equals: (in category 'accessing') ----- deny: unexpected equals: actual
^self deny: unexpected = actual description: 'Actual equals unexpected' !
Item was changed: + ----- Method: TestCase>>ensureInternetConnection (in category 'asserting - extensions') ----- - ----- Method: TestCase>>ensureInternetConnection (in category 'extensions') ----- ensureInternetConnection
^ self ensureInternetConnectionTo: 'http://www.google.com%27!
Item was changed: + ----- Method: TestCase>>ensureInternetConnectionTo: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>ensureInternetConnectionTo: (in category '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 changed: + ----- Method: TestCase>>ensureSecureInternetConnection (in category 'asserting - extensions') ----- - ----- Method: TestCase>>ensureSecureInternetConnection (in category 'extensions') ----- ensureSecureInternetConnection
^ self ensureInternetConnectionTo: 'https://www.google.com%27!
Item was changed: + ----- Method: TestCase>>executeShould:inScopeOf:withExceptionDo: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>executeShould:inScopeOf:withExceptionDo: (in category 'extensions') ----- executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock
^[aBlock value. false] on: anException do: [:exception | anotherBlock value: exception. exception return: true]!
Item was changed: + ----- Method: TestCase>>fail (in category 'asserting - extensions') ----- - ----- Method: TestCase>>fail (in category 'extensions') ----- fail
^self assert: false!
Item was changed: + ----- Method: TestCase>>fail: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>fail: (in category 'extensions') ----- fail: aString
^self assert: false description: aString.!
Item was changed: + ----- Method: TestCase>>should: (in category 'asserting') ----- - ----- Method: TestCase>>should: (in category 'accessing') ----- should: aBlock self assert: aBlock value !
Item was changed: + ----- Method: TestCase>>should:description: (in category 'asserting') ----- - ----- Method: TestCase>>should:description: (in category 'accessing') ----- should: aBlock description: aString self assert: aBlock value description: aString !
Item was changed: + ----- Method: TestCase>>should:notTakeMoreThan: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>should:notTakeMoreThan: (in category '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 changed: + ----- Method: TestCase>>should:notTakeMoreThanMilliseconds: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>should:notTakeMoreThanMilliseconds: (in category 'extensions') ----- should: aBlock notTakeMoreThanMilliseconds: anInteger "For compatibility with other Smalltalks"
self should: aBlock notTakeMoreThan: (Duration milliSeconds: anInteger).!
Item was changed: + ----- Method: TestCase>>should:raise: (in category 'asserting') ----- - ----- Method: TestCase>>should:raise: (in category 'accessing') ----- should: aBlock raise: anExceptionalEvent ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) !
Item was changed: + ----- Method: TestCase>>should:raise:description: (in category 'asserting') ----- - ----- Method: TestCase>>should:raise:description: (in category 'accessing') ----- should: aBlock raise: anExceptionalEvent description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) description: aString !
Item was changed: + ----- Method: TestCase>>should:raise:whoseDescriptionDoesNotInclude:description: (in category 'asserting') ----- - ----- Method: TestCase>>should:raise:whoseDescriptionDoesNotInclude:description: (in category 'accessing') ----- should: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString) description: aString !
Item was changed: + ----- Method: TestCase>>should:raise:whoseDescriptionIncludes:description: (in category 'asserting') ----- - ----- Method: TestCase>>should:raise:whoseDescriptionIncludes:description: (in category 'accessing') ----- should: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString) description: aString !
Item was changed: + ----- Method: TestCase>>should:raise:withExceptionDo: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>should:raise:withExceptionDo: (in category 'extensions') ----- should: aBlock raise: anException withExceptionDo: anotherBlock
^self assert: (self executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock)!
Item was changed: + ----- Method: TestCase>>shouldFix: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>shouldFix: (in category 'extensions') ----- shouldFix: aBlock
^self should: aBlock raise: Exception!
Item was changed: + ----- Method: TestCase>>shouldnt: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt: (in category 'accessing') ----- shouldnt: aBlock self deny: aBlock value !
Item was changed: + ----- Method: TestCase>>shouldnt:description: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:description: (in category 'accessing') ----- shouldnt: aBlock description: aString self deny: aBlock value description: aString !
Item was changed: + ----- Method: TestCase>>shouldnt:raise: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:raise: (in category 'accessing') ----- shouldnt: aBlock raise: anExceptionalEvent ^ [ aBlock value ] on: anExceptionalEvent do: [:e | self fail: 'Block raised ', e className, ': ', e messageText].!
Item was changed: + ----- Method: TestCase>>shouldnt:raise:description: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:raise:description: (in category 'accessing') ----- shouldnt: aBlock raise: anExceptionalEvent description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not description: aString !
Item was changed: + ----- Method: TestCase>>shouldnt:raise:whoseDescriptionDoesNotInclude:description: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:raise:whoseDescriptionDoesNotInclude:description: (in category 'accessing') ----- shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString) not description: aString !
Item was changed: + ----- Method: TestCase>>shouldnt:raise:whoseDescriptionIncludes:description: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:raise:whoseDescriptionIncludes:description: (in category 'accessing') ----- shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString) not description: aString !
Item was changed: + ----- Method: TestCase>>signalFailure: (in category 'private') ----- - ----- Method: TestCase>>signalFailure: (in category 'accessing') ----- signalFailure: aString TestResult failure signal: aString!
Item was changed: + ----- Method: TestCase>>timeout: (in category 'running - timeout') ----- - ----- Method: TestCase>>timeout: (in category 'accessing') ----- 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 changed: + ----- Method: TestCase>>timeout:after: (in category 'private') ----- - ----- Method: TestCase>>timeout:after: (in category 'running') ----- 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') ] ] 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, Error, Halt 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 changed: + ----- Method: TestCase>>timeoutForSetUp (in category 'running - timeout') ----- - ----- Method: TestCase>>timeoutForSetUp (in category 'accessing') ----- 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 changed: + ----- Method: TestCase>>timeoutForTest (in category 'running - timeout') ----- - ----- Method: TestCase>>timeoutForTest (in category 'accessing') ----- 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]!