| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108 |
- Smalltalk createPackage: 'Helios-SUnit'!
- HLWidget subclass: #HLSUnit
- instanceVariableNames: 'model packagesListWidget resultWidget'
- package: 'Helios-SUnit'!
- !HLSUnit commentStamp!
- I am the main widget for running unit tests in Helios.
- 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.!
- !HLSUnit methodsFor: 'accessing'!
- model
- ^ model ifNil: [ model := HLSUnitModel new ]
- ! !
- !HLSUnit methodsFor: 'rendering'!
- renderContentOn: html
- html with: (HLVerticalSplitter
- with: self packagesListWidget
- with: self resultWidget).
-
- self packagesListWidget focus
- ! !
- !HLSUnit methodsFor: 'widgets'!
- packagesListWidget
- ^ packagesListWidget ifNil: [
- packagesListWidget := HLSUnitPackagesListWidget on: self model ]
- !
- resultWidget
- ^ resultWidget ifNil: [
- resultWidget := HLWidget new ]
- ! !
- !HLSUnit class methodsFor: 'accessing'!
- tabClass
- ^ 'sunit'
- !
- tabLabel
- ^ 'SUnit'
- !
- tabPriority
- ^ 1000
- ! !
- !HLSUnit class methodsFor: 'testing'!
- canBeOpenAsTab
- ^ true
- ! !
- HLModel subclass: #HLSUnitModel
- instanceVariableNames: 'selectedPackages'
- package: 'Helios-SUnit'!
- !HLSUnitModel methodsFor: 'accessing'!
- selectedPackages
- ^ selectedPackages ifNil: [ selectedPackages := Set new ]
- !
- testPackages
- "Answer all packages containing concrete subclasses of TestCase"
-
- ^ self environment packages
- select: [ :each | each isTestPackage ]
- ! !
- !HLSUnitModel methodsFor: 'actions'!
- selectPackage: aPackage
- self packages add: aPackage
- !
- unselectPackage: aPackage
- self packages remove: aPackage ifAbsent: []
- ! !
- HLWidget subclass: #HLSUnitPackagesListWidget
- instanceVariableNames: 'model'
- package: 'Helios-SUnit'!
- !HLSUnitPackagesListWidget commentStamp!
- I display a list of packages for which unit tests are associated (packages containing subclasses of `TestCase`).!
- !HLSUnitPackagesListWidget methodsFor: 'accessing'!
- model
- ^ model
- !
- model: anObject
- model := anObject
- ! !
- !HLSUnitPackagesListWidget class methodsFor: 'instance creation'!
- on: aSUnitModel
- ^ self new
- model: aSUnitModel;
- yourself
- ! !
|
