SUnit.st 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329
  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: #RunningTestContext
  13. instanceVariableNames: 'finished testCase result'
  14. package: 'SUnit'!
  15. !RunningTestContext methodsFor: 'accessing'!
  16. finished: aBlock
  17. finished := aBlock
  18. !
  19. result: aTestResult
  20. result := aTestResult
  21. !
  22. testCase: aTestCase
  23. testCase := aTestCase
  24. ! !
  25. !RunningTestContext methodsFor: 'running'!
  26. execute: aBlock
  27. testCase context: self.
  28. [[[ aBlock
  29. ensure: [ testCase context: nil.
  30. testCase isAsync ifFalse: [ testCase tearDown ]]]
  31. on: TestFailure do: [:ex | testCase isAsync ifTrue: [ testCase finished ]. result addFailure: testCase]]
  32. on: Error do: [:ex | testCase isAsync ifTrue: [ testCase finished ]. result addError: testCase]]
  33. ensure: [ testCase isAsync ifFalse: [
  34. result increaseRuns.
  35. finished value ]]
  36. !
  37. start
  38. self execute: [ testCase setUp. testCase performTest ]
  39. ! !
  40. !RunningTestContext class methodsFor: 'instance creation'!
  41. testCase: aTestCase result: aTestResult finished: aBlock
  42. ^self new
  43. testCase: aTestCase;
  44. result: aTestResult;
  45. finished: aBlock;
  46. yourself
  47. ! !
  48. Object subclass: #TestCase
  49. instanceVariableNames: 'testSelector asyncTimeout context'
  50. package: 'SUnit'!
  51. !TestCase methodsFor: 'accessing'!
  52. context: aRunningTestContext
  53. context := aRunningTestContext
  54. !
  55. selector
  56. ^testSelector
  57. !
  58. setTestSelector: aSelector
  59. testSelector := aSelector
  60. ! !
  61. !TestCase methodsFor: 'async'!
  62. async: aBlock
  63. | c |
  64. self mustBeAsync: '#async'.
  65. c := context.
  66. ^[ c execute: aBlock ]
  67. !
  68. finished
  69. self mustBeAsync: '#finished'.
  70. asyncTimeout := nil
  71. !
  72. graceTime: millis
  73. asyncTimeout := true
  74. !
  75. isAsync
  76. ^asyncTimeout notNil
  77. !
  78. mustBeAsync: aString
  79. self isAsync ifFalse: [ self error: aString, ' used without prior #graceTime:' ]
  80. ! !
  81. !TestCase methodsFor: 'private'!
  82. signalFailure: aString
  83. TestFailure new
  84. messageText: aString;
  85. signal
  86. ! !
  87. !TestCase methodsFor: 'running'!
  88. performTest
  89. asyncTimeout := nil.
  90. self perform: self selector
  91. !
  92. runCase
  93. [ self setUp.
  94. self performTest ] ensure: [
  95. self tearDown ]
  96. !
  97. setUp
  98. !
  99. tearDown
  100. ! !
  101. !TestCase methodsFor: 'testing'!
  102. assert: aBoolean
  103. self assert: aBoolean description: 'Assertion failed'
  104. !
  105. assert: aBoolean description: aString
  106. aBoolean ifFalse: [self signalFailure: aString]
  107. !
  108. assert: expected equals: actual
  109. ^ self assert: (expected = actual) description: 'Expected: ', expected asString, ' but was: ', actual asString
  110. !
  111. deny: aBoolean
  112. self assert: aBoolean not
  113. !
  114. should: aBlock
  115. self assert: aBlock value
  116. !
  117. should: aBlock raise: anExceptionClass
  118. self assert: ([aBlock value. false]
  119. on: anExceptionClass
  120. do: [:ex | true])
  121. !
  122. shouldnt: aBlock raise: anExceptionClass
  123. self assert: ([aBlock value. true]
  124. on: anExceptionClass
  125. do: [:ex | false])
  126. ! !
  127. !TestCase class methodsFor: 'accessing'!
  128. allTestSelectors
  129. | selectors |
  130. selectors := self testSelectors.
  131. self shouldInheritSelectors ifTrue: [
  132. selectors addAll: self superclass allTestSelectors].
  133. ^selectors
  134. !
  135. buildSuite
  136. ^self allTestSelectors collect: [:each | self selector: each]
  137. !
  138. lookupHierarchyRoot
  139. ^TestCase
  140. !
  141. selector: aSelector
  142. ^self new
  143. setTestSelector: aSelector;
  144. yourself
  145. !
  146. testSelectors
  147. ^self methodDictionary keys select: [:each | each match: '^test']
  148. ! !
  149. !TestCase class methodsFor: 'testing'!
  150. isAbstract
  151. ^ self name = 'TestCase'
  152. !
  153. shouldInheritSelectors
  154. ^self ~= self lookupHierarchyRoot
  155. ! !
  156. Error subclass: #TestFailure
  157. instanceVariableNames: ''
  158. package: 'SUnit'!
  159. Object subclass: #TestResult
  160. instanceVariableNames: 'timestamp runs errors failures total'
  161. package: 'SUnit'!
  162. !TestResult methodsFor: 'accessing'!
  163. addError: anError
  164. self errors add: anError
  165. !
  166. addFailure: aFailure
  167. self failures add: aFailure
  168. !
  169. errors
  170. ^errors
  171. !
  172. failures
  173. ^failures
  174. !
  175. increaseRuns
  176. runs := runs + 1
  177. !
  178. runs
  179. ^runs
  180. !
  181. status
  182. ^self errors isEmpty
  183. ifTrue: [
  184. self failures isEmpty
  185. ifTrue: ['success']
  186. ifFalse: ['failure']]
  187. ifFalse: ['error']
  188. !
  189. timestamp
  190. ^timestamp
  191. !
  192. total
  193. ^total
  194. !
  195. total: aNumber
  196. total := aNumber
  197. ! !
  198. !TestResult methodsFor: 'initialization'!
  199. initialize
  200. super initialize.
  201. timestamp := Date now.
  202. runs := 0.
  203. errors := Array new.
  204. failures := Array new.
  205. total := 0
  206. ! !
  207. !TestResult methodsFor: 'running'!
  208. nextRunDo: aBlock
  209. "Runs aBlock with index of next run
  210. or does nothing if no more runs"
  211. ^self runs == self total
  212. ifFalse: [ aBlock value: self runs + 1 ]
  213. ! !
  214. Object subclass: #TestSuiteRunner
  215. instanceVariableNames: 'suite result announcer runNextTest'
  216. package: 'SUnit'!
  217. !TestSuiteRunner methodsFor: 'accessing'!
  218. announcer
  219. ^announcer
  220. !
  221. result
  222. ^result
  223. !
  224. suite: aCollection
  225. suite := aCollection
  226. ! !
  227. !TestSuiteRunner methodsFor: 'actions'!
  228. resume
  229. runNextTest fork.
  230. announcer announce: (ResultAnnouncement new result: result)
  231. !
  232. run
  233. result total: suite size.
  234. self resume
  235. ! !
  236. !TestSuiteRunner methodsFor: 'initialization'!
  237. initialize
  238. super initialize.
  239. announcer := Announcer new.
  240. result := TestResult new.
  241. runNextTest := [ result nextRunDo: [ :index |
  242. (RunningTestContext testCase: (suite at: index) result: result finished: [ self resume ]) start ]].
  243. ! !
  244. !TestSuiteRunner class methodsFor: 'instance creation'!
  245. new
  246. self shouldNotImplement
  247. !
  248. on: aCollection
  249. ^super new suite: aCollection
  250. ! !