SystemOrganization addCategory: #HudsonBuildTools!
Object subclass: #HDTestReport
instanceVariableNames: 'suite stream'
classVariableNames: ''
poolDictionaries: ''
category: 'HudsonBuildTools'!
!HDTestReport class methodsFor: 'running' stamp: 'lr 1/10/2010 01:30'!
runCategories: aCollectionOfStrings
aCollectionOfStrings do: [ :each | self runCategory: each ]! !
!HDTestReport class methodsFor: 'running' stamp: 'lr 1/10/2010 01:30'!
runCategory: aString
self runClasses: (Smalltalk organization classesInCategory: aString) named: aString! !
!HDTestReport class methodsFor: 'running' stamp: 'lr 1/10/2010 02:15'!
runClasses: aCollectionOfClasses named: aString
| suite classes |
suite := TestSuite named: aString.
classes := (aCollectionOfClasses
select: [ :each | (each includesBehavior: TestCase) and: [ each isAbstract not ] ])
asSortedCollection: [ :a :b | a name <= b name ].
classes
do: [ :each | each addToSuiteFromSelectors: suite ].
self runSuite: suite! !
!HDTestReport class methodsFor: 'running' stamp: 'lr 1/10/2010 01:31'!
runPackage: aString
^ self runClasses: (PackageInfo named: aString) classes named: aString! !
!HDTestReport class methodsFor: 'running' stamp: 'lr 1/10/2010 01:31'!
runPackages: aCollectionOfStrings
aCollectionOfStrings do: [ :each | self runPackage: each ]! !
!HDTestReport class methodsFor: 'running' stamp: 'TestRunner 1/10/2010 00:58'!
runSuite: aTestSuite
self new
initializeOn: aTestSuite;
run! !
!HDTestReport methodsFor: 'private' stamp: 'lr 1/10/2010 01:07'!
encode: aString
^ ((aString asString
copyReplaceAll: '&' with: '&')
copyReplaceAll: '"' with: '"')
copyReplaceAll: '<' with: '<'! !
!HDTestReport methodsFor: 'initialization' stamp: 'lr 1/10/2010 01:03'!
initializeOn: aTestSuite
suite := aTestSuite! !
!HDTestReport methodsFor: 'running' stamp: 'lr 1/10/2010 01:01'!
run
self setUp.
[ self runAll ]
ensure: [ self tearDown ]! !
!HDTestReport methodsFor: 'running' stamp: 'lr 1/10/2010 01:58'!
run: aTestCase
| error time stack |
time := [ [ aTestCase runCase ]
on: Error , TestFailure
do: [ :err |
error := err.
stack := String streamContents: [ :str |
| context |
context := err signalerContext.
[ context notNil ] whileTrue: [
str print: context; cr.
context := context sender ] ] ] ]
timeToRun.
stream tab; nextPutAll: ''; cr.
(error isNil or: [ aTestCase expectedFailures includes: aTestCase selector ]) ifFalse: [
stream tab; tab; nextPutAll: ''; nextPutAll: (self encode: stack); nextPutAll: ''; cr ].
stream tab; nextPutAll: ''; cr! !
!HDTestReport methodsFor: 'running' stamp: 'lr 1/10/2010 01:27'!
runAll
suite tests do: [ :each | self run: each ]! !
!HDTestReport methodsFor: 'running' stamp: 'lr 1/10/2010 02:15'!
setUp
stream := StandardFileStream forceNewFileNamed: suite name , '.xml'.
stream nextPutAll: ''; cr.
stream nextPutAll: ''; cr! !
!HDTestReport methodsFor: 'running' stamp: 'lr 1/10/2010 01:05'!
tearDown
suite resources
do: [ :each | each reset ].
stream nextPutAll: ''! !