I would like to add that in the default image. Could you create a bug entry and add your cs? Stefan did you sign the license agreemnet? Stef On May 22, 2011, at 4:41 PM, Stefan Marr wrote:
Hi Lukas:
On 22 May 2011, at 13:32, Lukas Renggli wrote:
Is there any alternative available to HDTestReport to be able to run headless tests, or actually run the SUnit tests in a non-morphic image?
Not that I know of. Ok, thanks.
The code below is a shameless ripoff of yours, stripped down to the basics, and meant for people that need a quick hack runner/reporter for SUnit test cases in a transcript or on any other stream for that matter.
So, in case anyone finds it useful, here you go:
'From Pharo1.3a of ''18 January 2011'' [Latest update: #13207] on 22 May 2011 at 4:35:01 pm'! Object subclass: #TestConsoleRunner instanceVariableNames: 'suite suitePosition suiteTime suiteFailures suiteErrors stream' classVariableNames: '' poolDictionaries: '' category: 'SUnit-UI'!
!TestConsoleRunner methodsFor: 'initialization' stamp: 'StefanMarr 5/22/2011 15:58'! initialize stream := self class defaultOutputTarget! !
!TestConsoleRunner methodsFor: 'initialization' stamp: 'StefanMarr 5/22/2011 15:53'! initializeOn: aTestSuite suite := aTestSuite. suitePosition := suiteTime := suiteFailures := suiteErrors := 0! !
!TestConsoleRunner methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 15:54'! run Author uniqueInstance ifUnknownAuthorUse: 'TestConsoleRunner' during: [ [ self setUp. suiteTime := [ self runAll ] timeToRun ] ensure: [ self tearDown ] ]! !
!TestConsoleRunner methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 16:03'! runAll suite tests do: [ :each | each run: self ]! !
!TestConsoleRunner methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 16:03'! runCase: aTestCase | error time stack | time := [ [ aTestCase runCase ] on: Halt , Error, TestFailure do: [ :err | error := err. stack := self stackTraceString: err of: aTestCase ] ] timeToRun. self beginTestCase: aTestCase time: time. (error isNil or: [ aTestCase expectedFailures includes: aTestCase selector ]) ifFalse: [ (error isKindOf: TestFailure) ifTrue: [ self writeError: error stack: stack ] ifFalse: [ self writeError: error stack: stack ] ]. self endTestCase! !
!TestConsoleRunner methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 16:03'! setUp stream nextPutAll: 'TestSuite '; nextPutAll: suite name; nextPutAll: ':'; nextPut: Character lf. stream nextPutAll: 'Tests: '; print: suite tests size; nextPut: Character lf.
"Initialize the test resources." suite resources do: [ :each | each isAvailable ifFalse: [ each signalInitializationError ] ]! !
!TestConsoleRunner methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 16:18'! tearDown suite resources do: [ :each | each reset ].
stream nextPutAll: 'failures='; print: suiteFailures; tab; nextPutAll:'errors='; print: suiteErrors; tab; nextPutAll: 'time='; print: suiteTime / 1000.0; nextPut: Character lf. ! !
!TestConsoleRunner methodsFor: 'private' stamp: 'StefanMarr 5/22/2011 16:16'! beginTestCase: aTestCase time: time stream tab; nextPutAll: (aTestCase class category); nextPut: $.; nextPutAll: (aTestCase class name); nextPut: $.; nextPutAll: (aTestCase selector); tab; nextPutAll: 'time='; print: time / 1000.0; nextPut: Character lf! !
!TestConsoleRunner methodsFor: 'private' stamp: 'StefanMarr 5/22/2011 16:16'! endTestCase stream tab; nextPut: Character lf! !
!TestConsoleRunner methodsFor: 'private' stamp: 'StefanMarr 5/22/2011 16:28'! stackTraceString: err of: aTestCase ^ String streamContents: [ :str | | context | context := err signalerContext. [ context isNil or: [ context receiver == aTestCase and: [ context methodSelector == #runCase ] ] ] whileFalse: [ str print: context; nextPut: Character lf. context := context sender ] ] ! !
!TestConsoleRunner methodsFor: 'private' stamp: 'StefanMarr 5/22/2011 16:30'! writeError: error stack: stack suiteErrors := suiteErrors + 1. stream tab; tab; nextPutAll: 'Error type='; nextPutAll: (error class name); tab; nextPutAll: ' message='; nextPutAll: (error messageText ifNil: [ error description ]); nextPut: Character lf; nextPutAll: stack; nextPut: Character lf; nextPut: Character lf! !
!TestConsoleRunner methodsFor: 'private' stamp: 'StefanMarr 5/22/2011 16:31'! writeFailure: error stack: stack suiteFailures := suiteFailures + 1.
stream tab; tab; nextPutAll: 'Failure type='; nextPutAll: (error class name); tab; nextPutAll: 'message='; nextPutAll: (error messageText ifNil: [ error description ]); nextPut: Character lf; nextPutAll: stack; nextPut: Character lf; nextPut: Character lf! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
TestConsoleRunner class instanceVariableNames: ''!
!TestConsoleRunner class methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 15:50'! runCategories: aCollectionOfStrings ^ aCollectionOfStrings do: [ :each | self runCategory: each ]! !
!TestConsoleRunner class methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 15:50'! runCategory: aString ^ self runClasses: (Smalltalk organization classesInCategory: aString) named: aString! !
!TestConsoleRunner class methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 15:52'! 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 isEmpty ifTrue: [ ^ self ]. classes do: [ :each | each addToSuiteFromSelectors: suite ]. ^ self runSuite: suite! !
!TestConsoleRunner class methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 15:52'! runPackage: aString ^ self runClasses: (PackageInfo named: aString) classes named: aString! !
!TestConsoleRunner class methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 15:50'! runPackages: aCollectionOfStrings ^ aCollectionOfStrings do: [ :each | self runPackage: each ]! !
!TestConsoleRunner class methodsFor: 'running' stamp: 'StefanMarr 5/22/2011 15:52'! runSuite: aTestSuite ^ self new initializeOn: aTestSuite; run! !
!TestConsoleRunner class methodsFor: 'defaults' stamp: 'StefanMarr 5/22/2011 15:57'! defaultOutputTarget ^ Transcript! !
Best regards Stefan
-- Stefan Marr Software Languages Lab Vrije Universiteit Brussel Pleinlaan 2 / B-1050 Brussels / Belgium http://soft.vub.ac.be/~smarr Phone: +32 2 629 2974 Fax: +32 2 629 3525