1
0

SUnit.st 7.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
  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. assert: expected equals: actual
  56. ^ self assert: (expected = actual)
  57. ! !
  58. TabWidget subclass: #ProgressBar
  59. instanceVariableNames: 'percent progressDiv div'
  60. category: 'SUnit'!
  61. !ProgressBar methodsFor: 'accessing'!
  62. percent
  63. ^percent ifNil: [0]
  64. !
  65. percent: aNumber
  66. percent := aNumber
  67. ! !
  68. !ProgressBar methodsFor: 'rendering'!
  69. renderOn: html
  70. div := html div
  71. class: 'progress_bar';
  72. yourself.
  73. self renderProgressBar
  74. !
  75. renderProgressBar
  76. div contents: [:html |
  77. html div
  78. class: 'progress';
  79. style: 'width:', self percent asString, '%']
  80. ! !
  81. !ProgressBar methodsFor: 'updating'!
  82. updatePercent: aNumber
  83. self percent: aNumber.
  84. self renderProgressBar
  85. ! !
  86. Error subclass: #TestFailure
  87. instanceVariableNames: ''
  88. category: 'SUnit'!
  89. TabWidget subclass: #TestRunner
  90. instanceVariableNames: 'selectedCategories categoriesList selectedClasses classesList selectedMethods progressBar methodsList result statusDiv'
  91. category: 'SUnit'!
  92. !TestRunner methodsFor: 'accessing'!
  93. label
  94. ^'[Test runner]'
  95. !
  96. categories
  97. | categories |
  98. categories := Array new.
  99. self allClasses do: [:each |
  100. (categories includes: each category) ifFalse: [
  101. categories add: each category]].
  102. ^categories sort
  103. !
  104. classes
  105. ^(self allClasses
  106. select: [:each | self selectedCategories includes: each category])
  107. sort: [:a :b | a name > b name]
  108. !
  109. selectedCategories
  110. ^selectedCategories ifNil: [selectedCategories := Array new]
  111. !
  112. allClasses
  113. ^TestCase allSubclasses
  114. !
  115. selectedClasses
  116. ^selectedClasses ifNil: [selectedClasses := Array new]
  117. !
  118. progressBar
  119. ^progressBar ifNil: [progressBar := ProgressBar new]
  120. !
  121. selectedMethods
  122. ^selectedMethods ifNil: [self selectedClasses collect: [:each |
  123. each methodDictionary keys select: [:key | key beginsWith: 'test' ]]]
  124. !
  125. statusInfo
  126. ^self printTotal, self printPasses, self printErrors, self printFailures
  127. !
  128. result
  129. ^result
  130. !
  131. failedMethods
  132. self result failures collect: [:each |
  133. html li
  134. class: 'failures';
  135. with: each]
  136. ! !
  137. !TestRunner methodsFor: 'actions'!
  138. selectAllCategories
  139. self categories do: [:each |
  140. (selectedCategories includes: each) ifFalse: [
  141. self selectedCategories add: each]].
  142. self
  143. updateCategoriesList;
  144. updateClassesList
  145. !
  146. toggleCategory: aCategory
  147. (self isSelectedCategory: aCategory)
  148. ifFalse: [selectedCategories add: aCategory]
  149. ifTrue: [selectedCategories remove: aCategory].
  150. self
  151. updateCategoriesList;
  152. updateClassesList
  153. !
  154. toggleClass: aClass
  155. (self isSelectedClass: aClass)
  156. ifFalse: [selectedClasses add: aClass]
  157. ifTrue: [selectedClasses remove: aClass].
  158. self
  159. updateClassesList
  160. !
  161. selectAllClasses
  162. self classes do: [:each |
  163. (selectedClasses includes: each) ifFalse: [
  164. self selectedClasses add: each]].
  165. self
  166. updateCategoriesList;
  167. updateClassesList
  168. !
  169. run: aCollection
  170. result := TestResult new.
  171. self
  172. updateStatusDiv;
  173. updateMethodsList.
  174. self progressBar updatePercent: 0.
  175. result total: (aCollection inject: 0 into: [:acc :each | acc + each methods size]).
  176. aCollection do: [:each |
  177. [each runCaseFor: result.
  178. self progressBar updatePercent: result runs / result total * 100.
  179. self updateStatusDiv.
  180. self updateMethodsList] valueWithTimeout: 100].
  181. ! !
  182. !TestRunner methodsFor: 'initialization'!
  183. initialize
  184. super initialize.
  185. result := TestResult new
  186. ! !
  187. !TestRunner methodsFor: 'printing'!
  188. printErrors
  189. ^self result errors size asString , ' errors, '
  190. !
  191. printFailures
  192. ^self result failures size asString, ' failures'
  193. !
  194. printPasses
  195. ^(((self result total) - (self result errors size + (self result failures size))) asString) , ' passes, '
  196. !
  197. printTotal
  198. ^self result total asString, ' runs, '
  199. ! !
  200. !TestRunner methodsFor: 'rendering'!
  201. renderBoxOn: html
  202. self
  203. renderCategoriesOn: html;
  204. renderClassesOn: html;
  205. renderResultsOn: html
  206. !
  207. renderButtonsOn: html
  208. html button
  209. with: 'Run selected';
  210. onClick: [self run: (self selectedClasses collect: [:each | each new])]
  211. !
  212. renderCategoriesOn: html
  213. categoriesList := html ul class: 'jt_column sunit categories'.
  214. self updateCategoriesList
  215. !
  216. renderClassesOn: html
  217. classesList := html ul class: 'jt_column sunit classes'.
  218. self updateClassesList
  219. !
  220. renderResultsOn: html
  221. statusDiv := html div.
  222. html with: self progressBar.
  223. methodsList := html ul class: 'jt_column sunit methods'.
  224. self updateMethodsList.
  225. self updateStatusDiv
  226. !
  227. renderFailuresOn: html
  228. self result failures do: [:each |
  229. html li
  230. class: 'failures';
  231. with: each]
  232. !
  233. renderErrorsOn: html
  234. self result errors do: [:each |
  235. html li
  236. class: 'errors';
  237. with: each]
  238. ! !
  239. !TestRunner methodsFor: 'testing'!
  240. canBeClosed
  241. ^true
  242. !
  243. isSelectedClass: aClass
  244. ^(self selectedClasses includes: aClass)
  245. !
  246. isSelectedCategory: aCategory
  247. ^(self selectedCategories includes: aCategory)
  248. ! !
  249. !TestRunner methodsFor: 'updating'!
  250. updateCategoriesList
  251. categoriesList contents: [:html |
  252. html li
  253. class: 'all';
  254. with: 'All';
  255. onClick: [self selectAllCategories].
  256. self categories do: [:each || li |
  257. li := html li.
  258. (self selectedCategories includes: each) ifTrue: [
  259. li class: 'selected'].
  260. li
  261. with: each;
  262. onClick: [self toggleCategory: each]]]
  263. !
  264. updateClassesList
  265. classesList contents: [:html |
  266. (self selectedCategories isEmpty) ifFalse: [
  267. html li
  268. class: 'all';
  269. with: 'All';
  270. onClick: [self selectAllClasses]].
  271. self classes do: [:each || li |
  272. li := html li.
  273. (self selectedClasses includes: each) ifTrue: [
  274. li class: 'selected'].
  275. li
  276. with: each name;
  277. onClick: [self toggleClass: each]]]
  278. !
  279. updateMethodsList
  280. methodsList contents: [:html |
  281. self renderFailuresOn: html.
  282. self renderErrorsOn: html]
  283. !
  284. updateStatusDiv
  285. statusDiv class: 'sunit status ', result status.
  286. statusDiv contents: [:html |
  287. html span with: self statusInfo]
  288. ! !
  289. Object subclass: #TestResult
  290. instanceVariableNames: 'timestamp runs errors failures total'
  291. category: 'SUnit'!
  292. !TestResult methodsFor: 'accessing'!
  293. timestamp
  294. ^timestamp
  295. !
  296. errors
  297. ^errors
  298. !
  299. failures
  300. ^failures
  301. !
  302. total
  303. ^total
  304. !
  305. total: aNumber
  306. total := aNumber
  307. !
  308. addError: anError
  309. self errors add: anError
  310. !
  311. addFailure: aFailure
  312. self failures add: aFailure
  313. !
  314. runs
  315. ^runs
  316. !
  317. increaseRuns
  318. runs := runs + 1
  319. !
  320. status
  321. ^self errors isEmpty
  322. ifTrue: [
  323. self failures isEmpty
  324. ifTrue: ['success']
  325. ifFalse: ['failure']]
  326. ifFalse: ['error']
  327. ! !
  328. !TestResult methodsFor: 'initialization'!
  329. initialize
  330. super initialize.
  331. timestamp := Date now.
  332. runs := 0.
  333. errors := Array new.
  334. failures := Array new.
  335. total := 0
  336. ! !