SUnit.st 7.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390
  1. Smalltalk current createPackage: 'SUnit' properties: #{}!
  2. Object subclass: #ResultAnnouncement
  3. instanceVariableNames: 'result'
  4. package: 'SUnit'!
  5. !ResultAnnouncement methodsFor: 'accessing'!
  6. result
  7. ^result
  8. !
  9. result: aTestResult
  10. result := aTestResult
  11. ! !
  12. Object subclass: #TestCase
  13. instanceVariableNames: 'testSelector asyncTimeout context'
  14. package: 'SUnit'!
  15. !TestCase commentStamp!
  16. A TestCase is an implementation of the command pattern to run a test.
  17. `TestCase` instances are created with the class method `#selector:`,
  18. passing the symbol that names the method to be executed when the test case runs.
  19. When you discover a new fixture, subclass `TestCase` and create a `#test...` method for the first test.
  20. As that method develops and more `#test...` methods are added, you will find yourself refactoring temps
  21. into instance variables for the objects in the fixture and overriding `#setUp` to initialize these variables.
  22. As required, override `#tearDown` to nil references, release objects and deallocate.!
  23. !TestCase methodsFor: 'accessing'!
  24. context: aRunningTestContext
  25. context := aRunningTestContext
  26. !
  27. selector
  28. ^testSelector
  29. !
  30. setTestSelector: aSelector
  31. testSelector := aSelector
  32. ! !
  33. !TestCase methodsFor: 'async'!
  34. async: aBlock
  35. | c |
  36. self mustBeAsync: '#async'.
  37. c := context.
  38. ^[ self isAsync ifTrue: [ c execute: aBlock ]]
  39. !
  40. finished
  41. self mustBeAsync: '#finished'.
  42. asyncTimeout := nil
  43. !
  44. graceTime: millis
  45. asyncTimeout ifNotNil: [ asyncTimeout clearTimeout ].
  46. asyncTimeout := true. "to allow async:"
  47. asyncTimeout :=
  48. (self async: [ self assert: false description: 'SUnit grace time exhausted' ])
  49. valueWithTimeout: millis
  50. !
  51. isAsync
  52. ^asyncTimeout notNil
  53. !
  54. mustBeAsync: aString
  55. self isAsync ifFalse: [ self error: aString, ' used without prior #graceTime:' ]
  56. ! !
  57. !TestCase methodsFor: 'private'!
  58. signalFailure: aString
  59. TestFailure new
  60. messageText: aString;
  61. signal
  62. ! !
  63. !TestCase methodsFor: 'running'!
  64. performTest
  65. asyncTimeout := nil.
  66. self perform: self selector
  67. !
  68. runCase
  69. "Runs a test case in isolated context, leaking all errors."
  70. (TestContext testCase: self) start
  71. !
  72. setUp
  73. !
  74. tearDown
  75. ! !
  76. !TestCase methodsFor: 'testing'!
  77. assert: aBoolean
  78. self assert: aBoolean description: 'Assertion failed'
  79. !
  80. assert: aBoolean description: aString
  81. aBoolean ifFalse: [self signalFailure: aString]
  82. !
  83. assert: expected equals: actual
  84. ^ self assert: (expected = actual) description: 'Expected: ', expected asString, ' but was: ', actual asString
  85. !
  86. deny: aBoolean
  87. self assert: aBoolean not
  88. !
  89. should: aBlock
  90. self assert: aBlock value
  91. !
  92. should: aBlock raise: anExceptionClass
  93. self assert: ([aBlock value. false]
  94. on: anExceptionClass
  95. do: [:ex | true])
  96. !
  97. shouldnt: aBlock raise: anExceptionClass
  98. self assert: ([aBlock value. true]
  99. on: anExceptionClass
  100. do: [:ex | false])
  101. ! !
  102. !TestCase class methodsFor: 'accessing'!
  103. allTestSelectors
  104. | selectors |
  105. selectors := self testSelectors.
  106. self shouldInheritSelectors ifTrue: [
  107. selectors addAll: self superclass allTestSelectors].
  108. ^selectors
  109. !
  110. buildSuite
  111. ^self allTestSelectors collect: [:each | self selector: each]
  112. !
  113. lookupHierarchyRoot
  114. ^TestCase
  115. !
  116. selector: aSelector
  117. ^self new
  118. setTestSelector: aSelector;
  119. yourself
  120. !
  121. testSelectors
  122. ^self methodDictionary keys select: [:each | each match: '^test']
  123. ! !
  124. !TestCase class methodsFor: 'testing'!
  125. isAbstract
  126. ^ self name = 'TestCase'
  127. !
  128. shouldInheritSelectors
  129. ^self ~= self lookupHierarchyRoot
  130. ! !
  131. Object subclass: #TestContext
  132. instanceVariableNames: 'testCase'
  133. package: 'SUnit'!
  134. !TestContext commentStamp!
  135. TestContext governs running a particular test case.
  136. It's main added value is `#execute:` method which runs a block
  137. as a part of test case (restores context, nilling it afterwards,
  138. cleaning/calling tearDown as appropriate for sync/async scenario).!
  139. !TestContext methodsFor: 'accessing'!
  140. testCase: aTestCase
  141. testCase := aTestCase
  142. ! !
  143. !TestContext methodsFor: 'running'!
  144. execute: aBlock
  145. | failed |
  146. testCase context: self.
  147. [ failed := true. aBlock value. failed := false ] ensure: [
  148. testCase context: nil.
  149. (failed and: [testCase isAsync]) ifTrue: [ testCase finished ].
  150. testCase isAsync ifFalse: [ testCase tearDown ]
  151. ]
  152. !
  153. start
  154. self execute: [ testCase setUp. testCase performTest ]
  155. ! !
  156. !TestContext class methodsFor: 'instance creation'!
  157. testCase: aTestCase
  158. ^self new
  159. testCase: aTestCase;
  160. yourself
  161. ! !
  162. TestContext subclass: #ReportingTestContext
  163. instanceVariableNames: 'finished result'
  164. package: 'SUnit'!
  165. !ReportingTestContext commentStamp!
  166. ReportingTestContext adds `TestResult` reporting
  167. to `TestContext`.
  168. Errors are caught and save into a `TestResult`,
  169. When test case is finished (which can be later for async tests),
  170. a callback block is executed; this is used by a `TestSuiteRunner`.!
  171. !ReportingTestContext methodsFor: 'accessing'!
  172. finished: aBlock
  173. finished := aBlock
  174. !
  175. result: aTestResult
  176. result := aTestResult
  177. ! !
  178. !ReportingTestContext methodsFor: 'running'!
  179. execute: aBlock
  180. [
  181. [
  182. [ super execute: aBlock ]
  183. on: TestFailure
  184. do: [:ex | result addFailure: testCase ]
  185. ]
  186. on: Error
  187. do: [:ex | result addError: testCase]
  188. ]
  189. ensure: [ testCase isAsync ifFalse: [ result increaseRuns. finished value ] ]
  190. ! !
  191. !ReportingTestContext class methodsFor: 'instance creation'!
  192. testCase: aTestCase result: aTestResult finished: aBlock
  193. ^(super testCase: aTestCase)
  194. result: aTestResult;
  195. finished: aBlock;
  196. yourself
  197. ! !
  198. Error subclass: #TestFailure
  199. instanceVariableNames: ''
  200. package: 'SUnit'!
  201. !TestFailure commentStamp!
  202. The test framework distinguishes between failures and errors.
  203. A failure is an event whose possibiity is explicitly anticipated and checked for in an assertion,
  204. whereas an error is an unanticipated problem like a division by 0 or an index out of bounds.
  205. TestFailure is raised when the boolean parameter of an #`assert:` or `#deny:` call is the opposite of what the assertion claims.!
  206. Object subclass: #TestResult
  207. instanceVariableNames: 'timestamp runs errors failures total'
  208. package: 'SUnit'!
  209. !TestResult commentStamp!
  210. A TestResult implements the collecting parameter pattern for running a bunch of tests.
  211. A TestResult holds tests that have run, sorted into the result categories of passed, failures and errors.
  212. TestResult is an interesting object to subclass or substitute. `#runCase:` is the external protocol you need to reproduce!
  213. !TestResult methodsFor: 'accessing'!
  214. addError: anError
  215. self errors add: anError
  216. !
  217. addFailure: aFailure
  218. self failures add: aFailure
  219. !
  220. errors
  221. ^errors
  222. !
  223. failures
  224. ^failures
  225. !
  226. increaseRuns
  227. runs := runs + 1
  228. !
  229. runs
  230. ^runs
  231. !
  232. status
  233. ^self errors isEmpty
  234. ifTrue: [
  235. self failures isEmpty
  236. ifTrue: ['success']
  237. ifFalse: ['failure']]
  238. ifFalse: ['error']
  239. !
  240. timestamp
  241. ^timestamp
  242. !
  243. total
  244. ^total
  245. !
  246. total: aNumber
  247. total := aNumber
  248. ! !
  249. !TestResult methodsFor: 'initialization'!
  250. initialize
  251. super initialize.
  252. timestamp := Date now.
  253. runs := 0.
  254. errors := Array new.
  255. failures := Array new.
  256. total := 0
  257. ! !
  258. Object subclass: #TestSuiteRunner
  259. instanceVariableNames: 'suite result announcer runNextTest'
  260. package: 'SUnit'!
  261. !TestSuiteRunner methodsFor: 'accessing'!
  262. announcer
  263. ^announcer
  264. !
  265. result
  266. ^result
  267. !
  268. suite: aCollection
  269. suite := aCollection
  270. ! !
  271. !TestSuiteRunner methodsFor: 'actions'!
  272. resume
  273. runNextTest fork.
  274. announcer announce: (ResultAnnouncement new result: result)
  275. !
  276. run
  277. result total: suite size.
  278. self resume
  279. ! !
  280. !TestSuiteRunner methodsFor: 'initialization'!
  281. initialize
  282. super initialize.
  283. announcer := Announcer new.
  284. result := TestResult new.
  285. runNextTest := [ | runs | runs := result runs. runs < result total ifTrue: [ (self contextOf: runs + 1) start ]].
  286. ! !
  287. !TestSuiteRunner methodsFor: 'private'!
  288. contextOf: anInteger
  289. ^ReportingTestContext testCase: (suite at: anInteger) result: result finished: [ self resume ]
  290. ! !
  291. !TestSuiteRunner class methodsFor: 'instance creation'!
  292. new
  293. self shouldNotImplement
  294. !
  295. on: aCollection
  296. ^super new suite: aCollection
  297. ! !