#REFACTORING by cg
class: TestSuite
added: #allCoveredClasses
category of:
#areAllResourcesAvailable
#isTestCase
#isTestSuite
#signalUnavailableResources
"{ 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 §'
! !