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