SUnit.st 8.9 KB

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