|
1 'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:10:32 pm' ! |
|
2 |
|
3 "{ Package: 'stx:goodies/sunit' }" |
|
4 |
|
5 Object subclass:#TestSuitesScripter |
|
6 instanceVariableNames:'script stream' |
|
7 classVariableNames:'' |
|
8 poolDictionaries:'' |
|
9 category:'SUnit' |
|
10 ! |
|
11 |
|
12 !TestSuitesScripter class methodsFor:'Example'! |
|
13 |
|
14 exampleScripting |
|
15 ^(TestSuitesScripter script: ' "scratch suite 3" ExampleSetTest SUnitTest* ') value |
|
16 |
|
17 "Modified: / 21.6.2000 / 10:18:08 / Sames" |
|
18 ! ! |
|
19 |
|
20 !TestSuitesScripter class methodsFor:'Init / Release'! |
|
21 |
|
22 run: aString |
|
23 ^self new run: aString! |
|
24 |
|
25 script: aString |
|
26 ^self new setScript: aString! ! |
|
27 |
|
28 !TestSuitesScripter methodsFor:'Printing'! |
|
29 |
|
30 printOn: aStream |
|
31 aStream nextPutAll: (script isNil |
|
32 ifFalse: [script] |
|
33 ifTrue: ['N/A']) |
|
34 |
|
35 "Created: / 21.6.2000 / 10:15:29 / Sames" |
|
36 ! ! |
|
37 |
|
38 !TestSuitesScripter methodsFor:'Private'! |
|
39 |
|
40 executeSingleSuiteScript: aString |
|
41 | useHierachy realName testCase | |
|
42 aString last = $* |
|
43 ifTrue: |
|
44 [realName := aString copyFrom: 1 to: aString size - 1. |
|
45 useHierachy := true] |
|
46 ifFalse: |
|
47 [realName := aString. |
|
48 useHierachy := false]. |
|
49 realName isEmpty ifTrue: [^nil]. |
|
50 testCase := SUnitNameResolver classNamed: realName sunitAsSymbol. |
|
51 testCase isNil ifTrue: [^nil]. |
|
52 ^useHierachy |
|
53 ifTrue: [self hierachyOfTestSuitesFrom: testCase] |
|
54 ifFalse: [testCase suite] |
|
55 |
|
56 "Modified: / 21.6.2000 / 10:16:02 / Sames" |
|
57 ! |
|
58 |
|
59 getNextToken |
|
60 [stream atEnd not and: [stream peek first = $"]] whileTrue: [self skipComment]. |
|
61 ^stream atEnd not |
|
62 ifTrue: [stream next] |
|
63 ifFalse: [nil] |
|
64 |
|
65 "Modified: / 21.6.2000 / 10:16:16 / Sames" |
|
66 ! |
|
67 |
|
68 hierachyOfTestSuitesFrom: aTestCase |
|
69 | subSuite | |
|
70 subSuite := TestSuite new. |
|
71 subSuite addTest: aTestCase suite. |
|
72 aTestCase allSubclasses do: [:each | subSuite addTest: each sunitName sunitAsSymbol sunitAsClass suite]. |
|
73 ^subSuite |
|
74 |
|
75 "Modified: / 21.6.2000 / 10:16:29 / Sames" |
|
76 ! |
|
77 |
|
78 setScript: aString |
|
79 script := aString! |
|
80 |
|
81 skipComment |
|
82 | token inComment | |
|
83 token := stream next. |
|
84 token size > 1 & (token last = $") ifTrue: [^nil]. |
|
85 inComment := true. |
|
86 [inComment & stream atEnd not] |
|
87 whileTrue: |
|
88 [token := stream next. |
|
89 token last = $" ifTrue: [inComment := false]] |
|
90 |
|
91 "Modified: / 21.6.2000 / 10:16:47 / Sames" |
|
92 ! ! |
|
93 |
|
94 !TestSuitesScripter methodsFor:'Scripting'! |
|
95 |
|
96 run: aString |
|
97 | suite subSuite token | |
|
98 suite := TestSuite new. |
|
99 stream := ReadStream on: aString sunitSubStrings. |
|
100 [stream atEnd] whileFalse: |
|
101 [token := self getNextToken. |
|
102 token notNil ifTrue: [ |
|
103 subSuite := self executeSingleSuiteScript: token. |
|
104 subSuite notNil ifTrue:[suite addTest: subSuite]]]. |
|
105 ^suite |
|
106 |
|
107 "Modified: / 21.6.2000 / 10:17:11 / Sames" |
|
108 ! |
|
109 |
|
110 value |
|
111 ^self run: script! ! |
|
112 |