The Trunk: SUnit-pre.122.mcz

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'!

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'!

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]!