SUnit.st 8.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449
  1. Object subclass: #TestCase
  2. instanceVariableNames: 'testedClass'
  3. category: 'SUnit'!
  4. !TestCase methodsFor: 'accessing'!
  5. testedClass
  6. ^testedClass
  7. !
  8. testedClass: aClass
  9. testedClass := aClass
  10. ! !
  11. !TestCase methodsFor: 'private'!
  12. cleanUpInstanceVariables
  13. self class instanceVariableNames do: [ :name |
  14. name = 'testSelector' ifFalse: [
  15. self instVarAt: name put: nil ]]
  16. !
  17. signalFailure: aString
  18. TestFailure new
  19. messageText: aString;
  20. signal
  21. ! !
  22. !TestCase methodsFor: 'running'!
  23. setUp
  24. !
  25. tearDown
  26. !
  27. methods
  28. ^self class methodDictionary keys select: [:each | each match: '^test']
  29. !
  30. runCaseFor: aTestResult
  31. [self setUp.
  32. self performTestFor: aTestResult]
  33. on: Error
  34. do: [:ex |
  35. self tearDown.
  36. self cleanUpInstanceVariables.
  37. ex signal].
  38. self tearDown.
  39. self cleanUpInstanceVariables
  40. !
  41. performTestFor: aResult
  42. self methods do: [:each |
  43. [[self perform: each]
  44. on: TestFailure do: [:ex | aResult addFailure: self class name, '>>', each]]
  45. on: Error do: [:ex | aResult addError: self class name, '>>', each].
  46. aResult increaseRuns]
  47. ! !
  48. !TestCase methodsFor: 'testing'!
  49. assert: aBoolean
  50. aBoolean ifFalse: [self signalFailure: 'Assertion failed']
  51. !
  52. deny: aBoolean
  53. self assert: aBoolean not
  54. ! !
  55. TestCase subclass: #ExampleTest
  56. instanceVariableNames: 'test'
  57. category: 'SUnit'!
  58. !ExampleTest methodsFor: 'not yet classified'!
  59. testFailure
  60. self deny: true
  61. !
  62. testPasses
  63. 100000 timesRepeat: [self assert: 1 + 1 = 2]
  64. !
  65. testError
  66. self assert: 1 foo
  67. ! !
  68. TabWidget subclass: #ProgressBar
  69. instanceVariableNames: 'percent progressDiv'
  70. category: 'SUnit'!
  71. !ProgressBar methodsFor: 'accessing'!
  72. percent
  73. ^percent ifNil: [0]
  74. !
  75. percent: aNumber
  76. percent := aNumber
  77. ! !
  78. !ProgressBar methodsFor: 'rendering'!
  79. renderOn: html
  80. html div
  81. class: 'progress_bar';
  82. with: [
  83. html div
  84. class: 'progress';
  85. style: 'width:', self percent asString, '%']
  86. ! !
  87. !ProgressBar methodsFor: 'updating'!
  88. updatePercent: aNumber
  89. self percent: aNumber.
  90. self update
  91. ! !
  92. Error subclass: #TestFailure
  93. instanceVariableNames: ''
  94. category: 'SUnit'!
  95. TabWidget subclass: #TestRunner
  96. instanceVariableNames: 'selectedCategories categoriesList selectedClasses classesList selectedMethods progressBar methodsList result statusDiv'
  97. category: 'SUnit'!
  98. !TestRunner methodsFor: 'accessing'!
  99. label
  100. ^'[Test runner]'
  101. !
  102. categories
  103. | categories |
  104. categories := Array new.
  105. self allClasses do: [:each |
  106. (categories includes: each category) ifFalse: [
  107. categories add: each category]].
  108. ^categories sort
  109. !
  110. classes
  111. ^(self allClasses
  112. select: [:each | self selectedCategories includes: each category])
  113. sort: [:a :b | a name > b name]
  114. !
  115. selectedCategories
  116. ^selectedCategories ifNil: [selectedCategories := Array new]
  117. !
  118. allClasses
  119. ^TestCase allSubclasses
  120. !
  121. selectedClasses
  122. ^selectedClasses ifNil: [selectedClasses := Array new]
  123. !
  124. progressBar
  125. ^progressBar ifNil: [progressBar := ProgressBar new]
  126. !
  127. selectedMethods
  128. ^selectedMethods ifNil: [self selectedClasses collect: [:each |
  129. each methodDictionary keys select: [:key | key beginsWith: 'test' ]]]
  130. !
  131. statusInfo
  132. ^self printTotal, self printPasses, self printErrors, self printFailures
  133. !
  134. result
  135. ^result
  136. !
  137. failedMethods
  138. self result failures collect: [:each |
  139. html li
  140. class: 'failures';
  141. with: each]
  142. ! !
  143. !TestRunner methodsFor: 'actions'!
  144. selectAllCategories
  145. self categories do: [:each |
  146. (selectedCategories includes: each) ifFalse: [
  147. self selectedCategories add: each]].
  148. self
  149. updateCategoriesList;
  150. updateClassesList
  151. !
  152. toggleCategory: aCategory
  153. (self isSelectedCategory: aCategory)
  154. ifFalse: [selectedCategories add: aCategory]
  155. ifTrue: [selectedCategories remove: aCategory].
  156. self
  157. updateCategoriesList;
  158. updateClassesList
  159. !
  160. toggleClass: aClass
  161. (self isSelectedClass: aClass)
  162. ifFalse: [selectedClasses add: aClass]
  163. ifTrue: [selectedClasses remove: aClass].
  164. self
  165. updateClassesList
  166. !
  167. selectAllClasses
  168. self classes do: [:each |
  169. (selectedClasses includes: each) ifFalse: [
  170. self selectedClasses add: each]].
  171. self
  172. updateCategoriesList;
  173. updateClassesList
  174. !
  175. run: aCollection
  176. result := TestResult new.
  177. self
  178. updateStatusDiv;
  179. updateMethodsList.
  180. self progressBar updatePercent: 0.
  181. result total: (aCollection inject: 0 into: [:acc :each | acc + each methods size]).
  182. aCollection do: [:each |
  183. [each runCaseFor: result.
  184. self progressBar updatePercent: result runs / result total * 100.
  185. self updateStatusDiv.
  186. self updateMethodsList] valueWithTimeout: 100].
  187. ! !
  188. !TestRunner methodsFor: 'initialization'!
  189. initialize
  190. super initialize.
  191. result := TestResult new
  192. ! !
  193. !TestRunner methodsFor: 'printing'!
  194. printErrors
  195. ^self result errors size asString , ' errors, '
  196. !
  197. printFailures
  198. ^self result failures size asString, ' failures'
  199. !
  200. printPasses
  201. ^(((self result total) - (self result errors size + (self result failures size))) asString) , ' passes, '
  202. !
  203. printTotal
  204. ^self result total asString, ' runs, '
  205. ! !
  206. !TestRunner methodsFor: 'rendering'!
  207. renderBoxOn: html
  208. self
  209. renderCategoriesOn: html;
  210. renderClassesOn: html;
  211. renderResultsOn: html
  212. !
  213. renderButtonsOn: html
  214. html button
  215. with: 'Run selected';
  216. onClick: [self run: (self selectedClasses collect: [:each | each new])]
  217. !
  218. renderCategoriesOn: html
  219. categoriesList := html ul class: 'jt_column sunit categories'.
  220. self updateCategoriesList
  221. !
  222. renderClassesOn: html
  223. classesList := html ul class: 'jt_column sunit classes'.
  224. self updateClassesList
  225. !
  226. renderResultsOn: html
  227. statusDiv := html div.
  228. html with: self progressBar.
  229. methodsList := html ul class: 'jt_column sunit methods'.
  230. self updateMethodsList.
  231. self updateStatusDiv
  232. !
  233. renderFailuresOn: html
  234. self result failures do: [:each |
  235. html li
  236. class: 'failures';
  237. with: each]
  238. !
  239. renderErrorsOn: html
  240. self result errors do: [:each |
  241. html li
  242. class: 'errors';
  243. with: each]
  244. ! !
  245. !TestRunner methodsFor: 'testing'!
  246. canBeClosed
  247. ^true
  248. !
  249. isSelectedClass: aClass
  250. ^(self selectedClasses includes: aClass)
  251. !
  252. isSelectedCategory: aCategory
  253. ^(self selectedCategories includes: aCategory)
  254. ! !
  255. !TestRunner methodsFor: 'updating'!
  256. updateCategoriesList
  257. categoriesList contents: [:html |
  258. html li
  259. class: 'all';
  260. with: 'All';
  261. onClick: [self selectAllCategories].
  262. self categories do: [:each || li |
  263. li := html li.
  264. (self selectedCategories includes: each) ifTrue: [
  265. li class: 'selected'].
  266. li
  267. with: each;
  268. onClick: [self toggleCategory: each]]]
  269. !
  270. updateClassesList
  271. classesList contents: [:html |
  272. (self selectedCategories isEmpty) ifFalse: [
  273. html li
  274. class: 'all';
  275. with: 'All';
  276. onClick: [self selectAllClasses]].
  277. self classes do: [:each || li |
  278. li := html li.
  279. (self selectedClasses includes: each) ifTrue: [
  280. li class: 'selected'].
  281. li
  282. with: each name;
  283. onClick: [self toggleClass: each]]]
  284. !
  285. updateMethodsList
  286. methodsList contents: [:html |
  287. self renderFailuresOn: html.
  288. self renderErrorsOn: html]
  289. !
  290. updateStatusDiv
  291. statusDiv class: 'sunit status ', result status.
  292. statusDiv contents: [:html |
  293. html span with: self statusInfo]
  294. ! !
  295. Object subclass: #TestResult
  296. instanceVariableNames: 'timestamp runs errors failures total'
  297. category: 'SUnit'!
  298. !TestResult methodsFor: 'accessing'!
  299. timestamp
  300. ^timestamp
  301. !
  302. errors
  303. ^errors
  304. !
  305. failures
  306. ^failures
  307. !
  308. total
  309. ^total
  310. !
  311. total: aNumber
  312. total := aNumber
  313. !
  314. addError: anError
  315. self errors add: anError
  316. !
  317. addFailure: aFailure
  318. self failures add: aFailure
  319. !
  320. runs
  321. ^runs
  322. !
  323. increaseRuns
  324. runs := runs + 1
  325. !
  326. status
  327. ^self errors isEmpty
  328. ifTrue: [
  329. self failures isEmpty
  330. ifTrue: ['success']
  331. ifFalse: ['failure']]
  332. ifFalse: ['error']
  333. ! !
  334. !TestResult methodsFor: 'initialization'!
  335. initialize
  336. super initialize.
  337. timestamp := Date now.
  338. runs := 0.
  339. errors := Array new.
  340. failures := Array new.
  341. total := 0
  342. ! !
  343. TestCase subclass: #ExampleTest2
  344. instanceVariableNames: ''
  345. category: 'SUnit'!
  346. !ExampleTest2 methodsFor: 'not yet classified'!
  347. testPasses
  348. 100000 timesRepeat: [self assert: 1 + 1 = 2]
  349. ! !
  350. TestCase subclass: #ExampleTest3
  351. instanceVariableNames: ''
  352. category: 'SUnit'!
  353. !ExampleTest3 methodsFor: 'not yet classified'!
  354. testPasses
  355. 100000 timesRepeat: [self assert: 1 + 1 = 2]
  356. ! !