Helios-SUnit.st 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747
  1. Smalltalk createPackage: 'Helios-SUnit'!
  2. HLToolListWidget subclass: #HLMultiSelectToolListWidget
  3. instanceVariableNames: ''
  4. package: 'Helios-SUnit'!
  5. !HLMultiSelectToolListWidget commentStamp!
  6. This is a list that handles multiple selection!
  7. !HLMultiSelectToolListWidget methodsFor: 'accessing'!
  8. activeItemCssClass
  9. ^'selector'
  10. !
  11. listCssClass
  12. ^'nav nav-multiselect nav-pills nav-stacked'
  13. !
  14. listCssClassForItem: anObject
  15. ^(super listCssClassForItem: anObject), ((self isSelected: anObject)
  16. ifTrue: [' active']
  17. ifFalse: ['']).
  18. ! !
  19. !HLMultiSelectToolListWidget methodsFor: 'actions'!
  20. select: anObject
  21. self subclassResponsibility
  22. !
  23. toggleListItem: aListItem
  24. | item |
  25. (aListItem get: 0) ifNil: [ ^ self ].
  26. "Find item"
  27. item := aListItem data: 'item'.
  28. self toggleSelection: item
  29. !
  30. toggleSelection: anObject
  31. (self isSelected: anObject)
  32. ifTrue: [ self unselect: anObject ]
  33. ifFalse: [self select: anObject ]
  34. !
  35. unselect: anObject
  36. self subclassResponsibility
  37. ! !
  38. !HLMultiSelectToolListWidget methodsFor: 'rendering'!
  39. reselectItem: anObject
  40. anObject ifNil: [^self].
  41. self toggleSelection: anObject
  42. ! !
  43. !HLMultiSelectToolListWidget methodsFor: 'testing'!
  44. isSelected: anObject
  45. self subclassResponsibility
  46. ! !
  47. HLMultiSelectToolListWidget subclass: #HLSUnitClassesListWidget
  48. instanceVariableNames: ''
  49. package: 'Helios-SUnit'!
  50. !HLSUnitClassesListWidget commentStamp!
  51. I display a list of classes (subclasses of `TestCase`).!
  52. !HLSUnitClassesListWidget methodsFor: 'accessing'!
  53. buttonsDivCssClass
  54. ^ 'buttons_bar'
  55. !
  56. cssClassForItem: aClass
  57. ^ aClass theNonMetaClass heliosClass
  58. !
  59. items
  60. ^ items ifNil: [ self initializeItems ]
  61. !
  62. label
  63. ^ 'Classes'
  64. ! !
  65. !HLSUnitClassesListWidget methodsFor: 'actions'!
  66. observeModel
  67. self model announcer
  68. on: HLPackageSelected
  69. send: #onPackageSelected:
  70. to: self;
  71. on: HLPackageUnselected
  72. send: #onPackageUnselected:
  73. to: self;
  74. on: HLClassSelected
  75. send: #onClassSelected:
  76. to: self;
  77. on: HLClassUnselected
  78. send: #onClassUnselected:
  79. to: self.
  80. !
  81. observeSystem
  82. self model systemAnnouncer
  83. on: ClassAdded
  84. send: #onClassAdded:
  85. to: self.
  86. !
  87. select: anObject
  88. model selectClass: anObject
  89. !
  90. unselect: anObject
  91. model unselectClass: anObject
  92. ! !
  93. !HLSUnitClassesListWidget methodsFor: 'initialization'!
  94. initializeItems
  95. ^items := model testClasses
  96. ! !
  97. !HLSUnitClassesListWidget methodsFor: 'reactions'!
  98. onClassAdded: anAnnouncement
  99. (self model selectedPackages includes: anAnnouncement theClass package)
  100. ifTrue: [
  101. self
  102. initializeItems;
  103. refresh ]
  104. !
  105. onClassSelected: anAnnouncement
  106. | listItem |
  107. listItem := self findListItemFor: anAnnouncement item.
  108. listItem addClass: 'active'.
  109. !
  110. onClassUnselected: anAnnouncement
  111. | listItem |
  112. listItem := self findListItemFor: anAnnouncement item.
  113. listItem removeClass: 'active'.
  114. !
  115. onPackageSelected: anAnnouncement
  116. self initializeItems;
  117. refresh
  118. !
  119. onPackageUnselected: anAnnouncement
  120. self initializeItems;
  121. refresh
  122. ! !
  123. !HLSUnitClassesListWidget methodsFor: 'rendering'!
  124. renderButtonsOn: html
  125. html button
  126. class: 'button';
  127. with: 'Select all';
  128. onClick: [ self model selectAllClasses ]
  129. !
  130. renderItemLabel: aClass on: html
  131. html with: aClass name
  132. ! !
  133. !HLSUnitClassesListWidget methodsFor: 'testing'!
  134. isSelected: anObject
  135. ^model selectedClasses includes: anObject
  136. ! !
  137. HLMultiSelectToolListWidget subclass: #HLSUnitPackagesListWidget
  138. instanceVariableNames: ''
  139. package: 'Helios-SUnit'!
  140. !HLSUnitPackagesListWidget commentStamp!
  141. I display a list of packages for which unit tests are associated (packages containing subclasses of `TestCase`).!
  142. !HLSUnitPackagesListWidget methodsFor: 'accessing'!
  143. buttonsDivCssClass
  144. ^ 'buttons_bar'
  145. !
  146. cssClassForItem: anItem
  147. ^ anItem isDirty
  148. ifTrue: [ 'package_dirty' ]
  149. ifFalse: [ 'package' ]
  150. !
  151. items
  152. ^ items ifNil: [ self initializeItems ]
  153. !
  154. label
  155. ^ 'Packages'
  156. ! !
  157. !HLSUnitPackagesListWidget methodsFor: 'actions'!
  158. observeModel
  159. self model announcer
  160. on: HLPackageSelected
  161. send: #onPackageSelected:
  162. to: self;
  163. on: HLPackageUnselected
  164. send: #onPackageUnselected:
  165. to: self
  166. !
  167. observeSystem
  168. self model systemAnnouncer
  169. on: ClassAdded
  170. send: #onClassAdded:
  171. to: self.
  172. !
  173. select: anObject
  174. model selectPackage: anObject
  175. !
  176. unselect: anObject
  177. model unselectPackage: anObject
  178. ! !
  179. !HLSUnitPackagesListWidget methodsFor: 'initialization'!
  180. initializeItems
  181. ^items := model testPackages
  182. sort: [:a :b | a name < b name]
  183. ! !
  184. !HLSUnitPackagesListWidget methodsFor: 'reactions'!
  185. onClassAdded: anAnnouncement
  186. ((self items includes: anAnnouncement theClass package) not and: [anAnnouncement theClass package isTestPackage])
  187. ifTrue: [
  188. self
  189. initializeItems;
  190. refresh ]
  191. !
  192. onPackageSelected: anAnnouncement
  193. | listItem |
  194. listItem := self findListItemFor: anAnnouncement item.
  195. listItem addClass: 'active'.
  196. !
  197. onPackageUnselected: anAnnouncement
  198. | listItem |
  199. listItem := self findListItemFor: anAnnouncement item.
  200. listItem removeClass: 'active'.
  201. ! !
  202. !HLSUnitPackagesListWidget methodsFor: 'rendering'!
  203. renderButtonsOn: html
  204. html button
  205. class: 'button';
  206. with: 'Run Tests';
  207. onClick: [ self model runTests ].
  208. html button
  209. class: 'button';
  210. with: 'Select all';
  211. onClick: [ self model selectAllPackages ]
  212. !
  213. renderItemLabel: aPackage on: html
  214. html with: aPackage name
  215. ! !
  216. !HLSUnitPackagesListWidget methodsFor: 'testing'!
  217. isSelected: anObject
  218. ^model selectedPackages includes: anObject
  219. ! !
  220. HLWidget subclass: #HLSUnit
  221. instanceVariableNames: 'model packagesListWidget classesListWidget resultWidget failuresWidget errorsWidget'
  222. package: 'Helios-SUnit'!
  223. !HLSUnit commentStamp!
  224. I am the main widget for running unit tests in Helios.
  225. I provide the ability to select set of tests to run per package, and a detailed result log with passed tests, failed tests and errors.!
  226. !HLSUnit methodsFor: 'accessing'!
  227. model
  228. ^ model ifNil: [ model := HLSUnitModel new ]
  229. !
  230. resultSection
  231. ^HLHorizontalSplitter
  232. with: self resultWidget
  233. with: (HLHorizontalSplitter
  234. with: self failuresWidget
  235. with: self errorsWidget)
  236. ! !
  237. !HLSUnit methodsFor: 'actions'!
  238. unregister
  239. super unregister.
  240. {
  241. self packagesListWidget.
  242. self classesListWidget.
  243. self resultWidget.
  244. self errorsWidget.
  245. self failuresWidget
  246. }
  247. do: [ :each | each unregister ]
  248. ! !
  249. !HLSUnit methodsFor: 'keybindings'!
  250. registerBindingsOn: aBindingGroup
  251. HLToolCommand
  252. registerConcreteClassesOn: aBindingGroup
  253. for: self model
  254. ! !
  255. !HLSUnit methodsFor: 'rendering'!
  256. renderContentOn: html
  257. | resultSection |
  258. html with: (HLContainer with: (
  259. HLVerticalSplitter
  260. with: (HLVerticalSplitter
  261. with: self packagesListWidget
  262. with: self classesListWidget)
  263. with: (resultSection := self resultSection))).
  264. [resultSection resize: 0] valueWithTimeout: 100.
  265. self packagesListWidget focus
  266. ! !
  267. !HLSUnit methodsFor: 'widgets'!
  268. classesListWidget
  269. ^ classesListWidget ifNil: [
  270. classesListWidget := HLSUnitClassesListWidget on: self model.
  271. classesListWidget next: self failuresWidget ]
  272. !
  273. errorsWidget
  274. ^ errorsWidget ifNil: [errorsWidget := HLSUnitErrorsListWidget on: self model]
  275. !
  276. failuresWidget
  277. ^ failuresWidget ifNil: [
  278. failuresWidget := HLSUnitFailuresListWidget on: self model.
  279. failuresWidget next: self errorsWidget]
  280. !
  281. packagesListWidget
  282. ^ packagesListWidget ifNil: [
  283. packagesListWidget := HLSUnitPackagesListWidget on: self model.
  284. packagesListWidget next: self classesListWidget]
  285. !
  286. resultWidget
  287. ^ resultWidget ifNil: [
  288. resultWidget := HLSUnitResults new
  289. model: self model;
  290. yourself]
  291. ! !
  292. !HLSUnit class methodsFor: 'accessing'!
  293. tabClass
  294. ^ 'sunit'
  295. !
  296. tabLabel
  297. ^ 'SUnit'
  298. !
  299. tabPriority
  300. ^ 1000
  301. ! !
  302. !HLSUnit class methodsFor: 'testing'!
  303. canBeOpenAsTab
  304. ^ true
  305. ! !
  306. HLModel subclass: #HLSUnitModel
  307. instanceVariableNames: 'selectedPackages selectedClasses testResult currentSuite'
  308. package: 'Helios-SUnit'!
  309. !HLSUnitModel commentStamp!
  310. I am the model for running unit tests in Helios.
  311. I provide the ability to select set of tests to run per package, and a detailed result log with passed tests, failed tests and errors.!
  312. !HLSUnitModel methodsFor: 'accessing'!
  313. currentSuite
  314. ^currentSuite
  315. !
  316. selectedClasses
  317. ^ (self unfilteredSelectedClasses) select: [ :each |
  318. self selectedPackages includes: each package ]
  319. !
  320. selectedPackages
  321. ^ selectedPackages ifNil: [ selectedPackages := Set new ]
  322. !
  323. testCases
  324. | testCases |
  325. testCases := #().
  326. self selectedClasses
  327. do: [ :each | testCases addAll: each buildSuite ].
  328. ^ testCases
  329. !
  330. testClasses
  331. "Answer all concrete subclasses of TestCase in selected packages"
  332. | stream |
  333. stream := Array new writeStream.
  334. self selectedPackages do: [ :package |
  335. stream nextPutAll: (package classes select: [ :each |
  336. each isTestClass ] ) ].
  337. ^ stream contents
  338. !
  339. testPackages
  340. "Answer all packages containing concrete subclasses of TestCase"
  341. ^ self environment packages
  342. select: [ :each | each isTestPackage ]
  343. !
  344. testResult
  345. ^testResult ifNil: [testResult := TestResult new]
  346. ! !
  347. !HLSUnitModel methodsFor: 'actions'!
  348. invertSelectedClasses
  349. self testClasses do: [:each |
  350. (self unfilteredSelectedClasses includes: each)
  351. ifTrue: [ self unselectClass: each ]
  352. ifFalse: [ self selectClass: each ]].
  353. !
  354. invertSelectedPackages
  355. self testPackages do: [:each |
  356. (self selectedPackages includes: each)
  357. ifTrue: [ self unselectPackage: each ]
  358. ifFalse: [ self selectPackage: each ]].
  359. !
  360. runTests
  361. | worker |
  362. worker := TestSuiteRunner on: self testCases.
  363. testResult := worker result.
  364. self announcer announce: (HLRunTests on: worker).
  365. self subscribeToTestSuite: worker.
  366. worker run
  367. !
  368. selectAllClasses
  369. self testClasses do: [:each | self selectClass: each].
  370. !
  371. selectAllPackages
  372. self testPackages do: [:each | self selectPackage: each].
  373. !
  374. selectClass: aClass
  375. self unfilteredSelectedClasses add: aClass.
  376. self announcer announce: (HLClassSelected on: aClass).
  377. !
  378. selectPackage: aPackage
  379. self selectedPackages add: aPackage.
  380. self announcer announce: (HLPackageSelected on: aPackage).
  381. !
  382. subscribeToTestSuite: aTestSuiteRunner
  383. currentSuite ifNotNil: [ currentSuite announcer unsubscribe: self].
  384. currentSuite := aTestSuiteRunner.
  385. currentSuite announcer
  386. on: ResultAnnouncement
  387. send: #onResultAnnouncement:
  388. to: self
  389. !
  390. unselectClass: aClass
  391. self unfilteredSelectedClasses remove: aClass ifAbsent: [^self].
  392. self announcer announce: (HLClassUnselected on: aClass).
  393. !
  394. unselectPackage: aPackage
  395. self selectedPackages remove: aPackage ifAbsent: [^self].
  396. self announcer announce: (HLPackageUnselected on: aPackage).
  397. ! !
  398. !HLSUnitModel methodsFor: 'private'!
  399. unfilteredSelectedClasses
  400. ^ (selectedClasses ifNil: [ selectedClasses := Set new ])
  401. ! !
  402. !HLSUnitModel methodsFor: 'reacting'!
  403. onResultAnnouncement: announcement
  404. "Propogate announcement"
  405. self announcer announce: announcement.
  406. ! !
  407. HLToolListWidget subclass: #HLSUnitResultListWidget
  408. instanceVariableNames: ''
  409. package: 'Helios-SUnit'!
  410. !HLSUnitResultListWidget commentStamp!
  411. I group the lists that display test results!
  412. !HLSUnitResultListWidget methodsFor: 'actions'!
  413. performFailure: aTestCase
  414. aTestCase runCase
  415. ! !
  416. !HLSUnitResultListWidget methodsFor: 'initialization'!
  417. observeModel
  418. self model announcer
  419. on: ResultAnnouncement
  420. send: #onResultAnnouncement:
  421. to: self
  422. ! !
  423. !HLSUnitResultListWidget methodsFor: 'reacting'!
  424. onResultAnnouncement: announcement
  425. self refresh.
  426. ! !
  427. !HLSUnitResultListWidget methodsFor: 'rendering'!
  428. renderItemLabel: anObject on: html
  429. html with: anObject class name, ' >> ', anObject selector
  430. !
  431. reselectItem: anObject
  432. self performFailure: anObject
  433. ! !
  434. HLSUnitResultListWidget subclass: #HLSUnitErrorsListWidget
  435. instanceVariableNames: ''
  436. package: 'Helios-SUnit'!
  437. !HLSUnitErrorsListWidget commentStamp!
  438. I display a list of tests that have errors!
  439. !HLSUnitErrorsListWidget methodsFor: 'accessing'!
  440. items
  441. ^self model testResult errors
  442. !
  443. label
  444. ^'Errors'
  445. ! !
  446. HLSUnitResultListWidget subclass: #HLSUnitFailuresListWidget
  447. instanceVariableNames: ''
  448. package: 'Helios-SUnit'!
  449. !HLSUnitFailuresListWidget commentStamp!
  450. I display a list of tests that have failures!
  451. !HLSUnitFailuresListWidget methodsFor: 'accessing'!
  452. items
  453. ^self model testResult failures
  454. !
  455. label
  456. ^'Failures'
  457. ! !
  458. HLWidget subclass: #HLSUnitResultStatus
  459. instanceVariableNames: 'model'
  460. package: 'Helios-SUnit'!
  461. !HLSUnitResultStatus commentStamp!
  462. I display the status of the previous test run
  463. 1. How many tests where run.
  464. * How many tests passed.
  465. * How many tests failed.
  466. * How many tests resulted in an error.!
  467. !HLSUnitResultStatus methodsFor: 'accessing'!
  468. model
  469. ^ model ifNil: [model := TestResult new]
  470. !
  471. model: anObject
  472. model := anObject.
  473. self observeModel.
  474. !
  475. result
  476. ^ self model testResult
  477. !
  478. statusCssClass
  479. ^'sunit status ', self result status
  480. !
  481. statusInfo
  482. ^ self printTotal, self printPasses, self printErrors, self printFailures
  483. ! !
  484. !HLSUnitResultStatus methodsFor: 'actions'!
  485. observeModel
  486. self model announcer
  487. on: ResultAnnouncement
  488. send: #onResultAnnouncement:
  489. to: self
  490. !
  491. unregister
  492. super unregister.
  493. self model announcer unsubscribe: self.
  494. ! !
  495. !HLSUnitResultStatus methodsFor: 'printing'!
  496. printErrors
  497. ^ self result errors size asString , ' errors, '
  498. !
  499. printFailures
  500. ^ self result failures size asString, ' failures'
  501. !
  502. printPasses
  503. ^ (self result runs - self result errors size - self result failures size) asString , ' passes, '
  504. !
  505. printTotal
  506. ^ self result total asString, ' runs, '
  507. ! !
  508. !HLSUnitResultStatus methodsFor: 'reacting'!
  509. onResultAnnouncement: announcement
  510. self refresh.
  511. ! !
  512. !HLSUnitResultStatus methodsFor: 'rendering'!
  513. renderContentOn: html
  514. html div
  515. class: self statusCssClass;
  516. with: [ html span with: self statusInfo ]
  517. ! !
  518. HLWidget subclass: #HLSUnitResults
  519. instanceVariableNames: 'model progressBarWidget resultStatusWidget'
  520. package: 'Helios-SUnit'!
  521. !HLSUnitResults commentStamp!
  522. I am the widget that displays the test results for a previous test run in Helios.
  523. I display.
  524. 1. The status of the tests.
  525. * Progress of the currently running test suite.!
  526. !HLSUnitResults methodsFor: 'accessing'!
  527. model
  528. ^model
  529. !
  530. model: anObject
  531. model := anObject.
  532. self observeModel
  533. !
  534. progressBarWidget
  535. ^progressBarWidget ifNil: [progressBarWidget := HLProgressBarWidget new
  536. label: '';
  537. yourself]
  538. !
  539. resultStatusWidget
  540. ^resultStatusWidget ifNil: [resultStatusWidget := HLSUnitResultStatus new
  541. model: self model;
  542. yourself]
  543. ! !
  544. !HLSUnitResults methodsFor: 'actions'!
  545. unregister
  546. super unregister.
  547. self model announcer unsubscribe: self.
  548. self resultStatusWidget unregister.
  549. ! !
  550. !HLSUnitResults methodsFor: 'initialization'!
  551. observeModel
  552. self model announcer
  553. on: HLRunTests
  554. send: #onRunTests:
  555. to: self;
  556. on: ResultAnnouncement
  557. send: #onResultAnnouncement:
  558. to: self
  559. ! !
  560. !HLSUnitResults methodsFor: 'reacting'!
  561. onResultAnnouncement: announcement
  562. [self progressBarWidget
  563. updateProgress: (self model testResult runs / self model testResult total * 100) rounded] valueWithTimeout: 10
  564. !
  565. onRunTests: announcement
  566. self progressBarWidget updateProgress: 0;
  567. refresh.
  568. ! !
  569. !HLSUnitResults methodsFor: 'rendering'!
  570. renderContentOn: html
  571. html with: self resultStatusWidget;
  572. with: self progressBarWidget
  573. ! !