1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 TestCase subclass:#PPCTokenVisitorTest |
|
6 instanceVariableNames:'node result visitor' |
|
7 classVariableNames:'' |
|
8 poolDictionaries:'' |
|
9 category:'PetitCompiler-Tests-Visitors' |
|
10 ! |
|
11 |
|
12 !PPCTokenVisitorTest methodsFor:'as yet unclassified'! |
|
13 |
|
14 asNode: aPPParser |
|
15 self error: 'deprecated'. |
|
16 ^ aPPParser asCompilerTree |
|
17 ! |
|
18 |
|
19 assert: object type: class |
|
20 self assert: object class == class |
|
21 ! |
|
22 |
|
23 setUp |
|
24 visitor := PPCTokenVisitor new. |
|
25 ! |
|
26 |
|
27 testAction |
|
28 | letterNode | |
|
29 letterNode := PPCMessagePredicateNode new |
|
30 message: #isLetter; |
|
31 yourself. |
|
32 |
|
33 node := PPCActionNode new |
|
34 block: [ :nodes | #foo ]; |
|
35 child: letterNode; |
|
36 yourself. |
|
37 |
|
38 result := visitor visit: node. |
|
39 self assert: result type: PPCMessagePredicateNode. |
|
40 self assert: result = letterNode. |
|
41 ! |
|
42 |
|
43 testAction2 |
|
44 | letterNode actionNode | |
|
45 |
|
46 letterNode := PPCMessagePredicateNode new |
|
47 predicate: #isLetter; |
|
48 yourself. |
|
49 |
|
50 actionNode := PPCActionNode new |
|
51 block: #boo; |
|
52 child: letterNode; |
|
53 yourself. |
|
54 |
|
55 node := PPCTokenNode new |
|
56 child: actionNode; |
|
57 yourself. |
|
58 |
|
59 result := visitor visit: node. |
|
60 |
|
61 self assert: result type: PPCMessagePredicateNode. |
|
62 self assert: result = letterNode. |
|
63 ! |
|
64 |
|
65 testAction3 |
|
66 | letterNode actionNode | |
|
67 |
|
68 letterNode := PPCMessagePredicateNode new |
|
69 predicate: #isLetter; |
|
70 yourself. |
|
71 |
|
72 actionNode := PPCActionNode new |
|
73 block: #foo; |
|
74 child: letterNode; |
|
75 yourself. |
|
76 |
|
77 node := PPCActionNode new |
|
78 block: #foo; |
|
79 child: actionNode; |
|
80 yourself. |
|
81 |
|
82 result := visitor visit: node. |
|
83 |
|
84 self assert: result type: PPCMessagePredicateNode. |
|
85 self assert: result = letterNode. |
|
86 ! |
|
87 |
|
88 testNotAction |
|
89 | literalNode actionNode | |
|
90 literalNode := PPCLiteralNode new |
|
91 literal: 'foo'; |
|
92 yourself. |
|
93 |
|
94 actionNode := PPCActionNode new |
|
95 block: #foo; |
|
96 child: literalNode; |
|
97 yourself. |
|
98 |
|
99 node := PPCNotNode new |
|
100 child: actionNode; |
|
101 yourself. |
|
102 |
|
103 result := visitor visit: node. |
|
104 |
|
105 self assert: result type: PPCNotNode. |
|
106 self assert: result child type: PPCLiteralNode. |
|
107 ! |
|
108 |
|
109 testNotAction2 |
|
110 | literalNode actionNode seqNode | |
|
111 literalNode := PPCLiteralNode new |
|
112 literal: 'foo'; |
|
113 yourself. |
|
114 |
|
115 seqNode := PPCSequenceNode new |
|
116 children: { literalNode . literalNode }; |
|
117 yourself. |
|
118 |
|
119 actionNode := PPCActionNode new |
|
120 block: #foo; |
|
121 child: seqNode; |
|
122 yourself. |
|
123 |
|
124 node := PPCNotNode new |
|
125 child: actionNode; |
|
126 yourself. |
|
127 |
|
128 result := visitor visit: node. |
|
129 |
|
130 self assert: result type: PPCNotNode. |
|
131 |
|
132 self assert: result child type: PPCTokenSequenceNode. |
|
133 self assert: result child firstChild type: PPCLiteralNode. |
|
134 self assert: result child secondChild type: PPCLiteralNode. |
|
135 ! |
|
136 |
|
137 testNotAction3 |
|
138 | literalNode actionNode seqNode | |
|
139 literalNode := PPCLiteralNode new |
|
140 literal: 'foo'; |
|
141 yourself. |
|
142 |
|
143 seqNode := PPCSequenceNode new |
|
144 children: { literalNode . literalNode }; |
|
145 yourself. |
|
146 |
|
147 actionNode := PPCSymbolActionNode new |
|
148 symbol: #second; |
|
149 child: seqNode; |
|
150 yourself. |
|
151 |
|
152 node := PPCNotNode new |
|
153 child: actionNode; |
|
154 yourself. |
|
155 |
|
156 result := visitor visit: node. |
|
157 |
|
158 self assert: result type: PPCNotNode. |
|
159 |
|
160 self assert: result child type: PPCTokenSequenceNode. |
|
161 self assert: result child firstChild type: PPCLiteralNode. |
|
162 self assert: result child secondChild type: PPCLiteralNode. |
|
163 ! |
|
164 |
|
165 testStarMessagePredicate |
|
166 | starNode | |
|
167 starNode := PPCStarMessagePredicateNode new |
|
168 message: #isLetter; |
|
169 yourself. |
|
170 |
|
171 node := PPCTokenNode new |
|
172 child: starNode; |
|
173 yourself. |
|
174 |
|
175 result := visitor visit: node. |
|
176 |
|
177 self assert: result type: PPCTokenStarMessagePredicateNode. |
|
178 ! |
|
179 |
|
180 testTokenSequence1 |
|
181 | letterNode1 letterNode2 | |
|
182 letterNode1 := PPCCharacterNode new character: $a. |
|
183 letterNode2 := PPCCharacterNode new character: $b. |
|
184 |
|
185 node := PPCSequenceNode new |
|
186 children: { letterNode1 . letterNode2 }; |
|
187 yourself. |
|
188 result := visitor visit: node. |
|
189 |
|
190 self assert: result type: PPCTokenSequenceNode. |
|
191 self assert: result firstChild = letterNode1. |
|
192 self assert: result secondChild = letterNode2. |
|
193 ! ! |
|
194 |
|