[Pharo-project] Any alternative to HDTestReport?

Stéphane Ducasse stephane.ducasse at inria.fr
Sun May 22 13:46:55 EDT 2011


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
> 
> 





More information about the Pharo-dev mailing list