SUnit.st 9.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461
  1. Smalltalk 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. classTag
  122. "Returns a tag or general category for this class.
  123. Typically used to help tools do some reflection.
  124. Helios, for example, uses this to decide what icon the class should display."
  125. ^ 'test'
  126. !
  127. lookupHierarchyRoot
  128. ^ TestCase
  129. !
  130. selector: aSelector
  131. ^ self new
  132. setTestSelector: aSelector;
  133. yourself
  134. !
  135. testSelectors
  136. ^ self methodDictionary keys select: [ :each | each match: '^test' ]
  137. ! !
  138. !TestCase class methodsFor: 'testing'!
  139. isAbstract
  140. ^ self name = 'TestCase'
  141. !
  142. isTestClass
  143. ^ self isAbstract not
  144. !
  145. shouldInheritSelectors
  146. ^ self ~= self lookupHierarchyRoot
  147. ! !
  148. Object subclass: #TestContext
  149. instanceVariableNames: 'testCase'
  150. package: 'SUnit'!
  151. !TestContext commentStamp!
  152. I govern running a particular test case.
  153. 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).!
  154. !TestContext methodsFor: 'accessing'!
  155. testCase: aTestCase
  156. testCase := aTestCase
  157. ! !
  158. !TestContext methodsFor: 'running'!
  159. execute: aBlock
  160. | failed |
  161. testCase context: self.
  162. [
  163. failed := true.
  164. aBlock value.
  165. failed := false
  166. ]
  167. ensure: [
  168. testCase context: nil.
  169. (failed and: [ testCase isAsync ]) ifTrue: [
  170. testCase finished ].
  171. testCase isAsync ifFalse: [
  172. testCase tearDown ] ]
  173. !
  174. start
  175. self execute: [
  176. testCase setUp.
  177. testCase performTest ]
  178. ! !
  179. !TestContext class methodsFor: 'instance creation'!
  180. testCase: aTestCase
  181. ^ self new
  182. testCase: aTestCase;
  183. yourself
  184. ! !
  185. TestContext subclass: #ReportingTestContext
  186. instanceVariableNames: 'finished result'
  187. package: 'SUnit'!
  188. !ReportingTestContext commentStamp!
  189. I add `TestResult` reporting to `TestContext`.
  190. Errors are caught and save into a `TestResult`,
  191. When test case is finished (which can be later for async tests), a callback block is executed; this is used by a `TestSuiteRunner`.!
  192. !ReportingTestContext methodsFor: 'accessing'!
  193. finished: aBlock
  194. finished := aBlock
  195. !
  196. result: aTestResult
  197. result := aTestResult
  198. ! !
  199. !ReportingTestContext methodsFor: 'private'!
  200. withErrorReporting: aBlock
  201. [ aBlock
  202. on: TestFailure
  203. do: [ :ex | result addFailure: testCase ]
  204. ]
  205. on: Error
  206. do: [ :ex | result addError: testCase ]
  207. ! !
  208. !ReportingTestContext methodsFor: 'running'!
  209. execute: aBlock
  210. [
  211. self withErrorReporting: [ super execute: aBlock ]
  212. ]
  213. ensure: [
  214. testCase isAsync ifFalse: [
  215. result increaseRuns. finished value ] ]
  216. ! !
  217. !ReportingTestContext class methodsFor: 'instance creation'!
  218. testCase: aTestCase result: aTestResult finished: aBlock
  219. ^ (super testCase: aTestCase)
  220. result: aTestResult;
  221. finished: aBlock;
  222. yourself
  223. ! !
  224. Error subclass: #TestFailure
  225. instanceVariableNames: ''
  226. package: 'SUnit'!
  227. !TestFailure commentStamp!
  228. I am raised when the boolean parameter of an #`assert:` or `#deny:` call is the opposite of what the assertion claims.
  229. The test framework distinguishes between failures and errors.
  230. A failure is an event whose possibiity is explicitly anticipated and checked for in an assertion,
  231. whereas an error is an unanticipated problem like a division by 0 or an index out of bounds.!
  232. Object subclass: #TestResult
  233. instanceVariableNames: 'timestamp runs errors failures total'
  234. package: 'SUnit'!
  235. !TestResult commentStamp!
  236. I implement the collecting parameter pattern for running a bunch of tests.
  237. My instances hold tests that have run, sorted into the result categories of passed, failures and errors.
  238. `TestResult` is an interesting object to subclass or substitute. `#runCase:` is the external protocol you need to reproduce!
  239. !TestResult methodsFor: 'accessing'!
  240. addError: anError
  241. self errors add: anError
  242. !
  243. addFailure: aFailure
  244. self failures add: aFailure
  245. !
  246. errors
  247. ^ errors
  248. !
  249. failures
  250. ^ failures
  251. !
  252. increaseRuns
  253. runs := runs + 1
  254. !
  255. runs
  256. ^ runs
  257. !
  258. status
  259. ^ self errors ifNotEmpty: [ 'error' ] ifEmpty: [
  260. self failures ifNotEmpty: [ 'failure' ] ifEmpty: [
  261. 'success' ]]
  262. !
  263. timestamp
  264. ^ timestamp
  265. !
  266. total
  267. ^ total
  268. !
  269. total: aNumber
  270. total := aNumber
  271. ! !
  272. !TestResult methodsFor: 'initialization'!
  273. initialize
  274. super initialize.
  275. timestamp := Date now.
  276. runs := 0.
  277. errors := Array new.
  278. failures := Array new.
  279. total := 0
  280. ! !
  281. !TestResult methodsFor: 'running'!
  282. nextRunDo: aBlock
  283. "Runs aBlock with index of next run or does nothing if no more runs"
  284. ^ self runs == self total
  285. ifFalse: [ aBlock value: self runs + 1 ]
  286. !
  287. runCase: aTestCase
  288. [ [ self increaseRuns.
  289. aTestCase runCase ]
  290. on: TestFailure do: [ :ex | self addFailure: aTestCase ]]
  291. on: Error do: [ :ex | self addError: aTestCase ]
  292. ! !
  293. Object subclass: #TestSuiteRunner
  294. instanceVariableNames: 'suite result announcer runNextTest'
  295. package: 'SUnit'!
  296. !TestSuiteRunner commentStamp!
  297. I am responsible for running a collection (`suite`) of tests.
  298. ## API
  299. Instances should be created using the class-side `#on:` method, taking a collection of tests to run as parameter.
  300. To run the test suite, use `#run`.!
  301. !TestSuiteRunner methodsFor: 'accessing'!
  302. announcer
  303. ^ announcer
  304. !
  305. result
  306. ^ result
  307. !
  308. suite: aCollection
  309. suite := aCollection
  310. ! !
  311. !TestSuiteRunner methodsFor: 'actions'!
  312. resume
  313. runNextTest fork.
  314. announcer announce: (ResultAnnouncement new result: result)
  315. !
  316. run
  317. result total: suite size.
  318. self resume
  319. ! !
  320. !TestSuiteRunner methodsFor: 'initialization'!
  321. initialize
  322. super initialize.
  323. announcer := Announcer new.
  324. result := TestResult new.
  325. runNextTest := [ | runs | runs := result runs. runs < result total ifTrue: [ (self contextOf: runs + 1) start ] ].
  326. ! !
  327. !TestSuiteRunner methodsFor: 'private'!
  328. contextOf: anInteger
  329. ^ ReportingTestContext testCase: (suite at: anInteger) result: result finished: [ self resume ]
  330. ! !
  331. !TestSuiteRunner class methodsFor: 'instance creation'!
  332. new
  333. self shouldNotImplement
  334. !
  335. on: aCollection
  336. ^ super new suite: aCollection
  337. ! !
  338. !Package methodsFor: '*SUnit'!
  339. isTestPackage
  340. ^ self classes anySatisfy: [ :each | each isTestClass ]
  341. ! !
  342. !TBehaviorDefaults methodsFor: '*SUnit'!
  343. isTestClass
  344. ^ false
  345. ! !