1
0

SUnit.st 9.2 KB

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