"{ Package: 'stx:goodies/sunit' }"

Object subclass:#TestSuitesScripter
	instanceVariableNames:'script stream'
	classVariableNames:''
	poolDictionaries:''
	category:'SUnit-Base'
!


!TestSuitesScripter class methodsFor:'example'!

exampleScripting
	^(TestSuitesScripter script: ' "scratch suite 3" ExampleSetTest SUnitTest* ') value

    "Modified: / 21.6.2000 / 10:18:08 / Sames"
! !

!TestSuitesScripter class methodsFor:'initialization & release'!

run: testClassNameString
        ^self new run: testClassNameString
!

script: aString
	^self new setScript: aString
! !

!TestSuitesScripter methodsFor:'printing'!

printOn: aStream
	aStream nextPutAll: (script isNil 
		ifFalse: [script] 
		ifTrue: ['N/A'])

    "Created: / 21.6.2000 / 10:15:29 / Sames"
! !

!TestSuitesScripter methodsFor:'private'!

executeSingleSuiteScript: aString 
        | useHierachy realName testCase |
        aString last = $*
                ifTrue: 
                        [realName := aString copyFrom: 1 to: aString size - 1.
                        useHierachy := true]
                ifFalse: 
                        [realName := aString.
                        useHierachy := false].
        realName isEmpty ifTrue: [^nil].
        testCase := Smalltalk classNamed: realName asSymbol.
        testCase isNil ifTrue: [^nil].
        ^useHierachy
                ifTrue: [self hierachyOfTestSuitesFrom: testCase]
                ifFalse: [testCase suite]

    "Modified: / 21.6.2000 / 10:16:02 / Sames"
!

getNextToken
	[stream atEnd not and: [stream peek first = $"]] whileTrue: [self skipComment].
	^stream atEnd not
		ifTrue: [stream next]
		ifFalse: [nil]

    "Modified: / 21.6.2000 / 10:16:16 / Sames"
!

hierachyOfTestSuitesFrom: aTestCase 
        | subSuite |
        subSuite := TestSuite new.
        subSuite name:aTestCase name.
        subSuite addTest: aTestCase suite.
        aTestCase allSubclasses do: [:each | subSuite addTest:(Smalltalk classNamed:each name asSymbol) suite].
        ^subSuite

    "Modified: / 21.6.2000 / 10:16:29 / Sames"
!

setScript: aString
	script := aString
!

skipComment
	| token inComment |
	token := stream next.
	token size > 1 & (token last = $") ifTrue: [^nil].
	inComment := true.
	[inComment & stream atEnd not]
		whileTrue: 
			[token := stream next.
			token last = $" ifTrue: [inComment := false]]

    "Modified: / 21.6.2000 / 10:16:47 / Sames"
! !

!TestSuitesScripter methodsFor:'scripting'!

run: testClassNameString
        | suite subSuite token |
        suite := TestSuite new.
        suite name:testClassNameString.

        stream := ReadStream on: testClassNameString asArrayOfSubstrings. 
        [stream atEnd] whileFalse: 
                [token := self getNextToken.
                token notNil ifTrue: [
                        subSuite := self executeSingleSuiteScript: token.
                        subSuite notNil ifTrue:[suite addTest: subSuite]]].
        ^suite

    "Modified: / 21.6.2000 / 10:17:11 / Sames"
!

value
	^self run: script
! !

!TestSuitesScripter class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesScripter.st,v 1.11 2011-11-24 11:51:24 cg Exp $'
!

version_SVN
    ^ '§Id: TestSuitesScripter.st,v 1.10 2011/06/29 19:15:49 cg Exp §'
! !