SUnit.st 8.7 KB

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