[Pharo-project] Any alternative to HDTestReport?

Stefan Marr pharo at stefan-marr.de
Sun May 22 16:41:41 CEST 2011


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




More information about the Pharo-project mailing list