1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }" |
1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }" |
2 |
2 |
3 "{ NameSpace: Smalltalk }" |
3 "{ NameSpace: Smalltalk }" |
4 |
4 |
5 TestCase subclass:#PPCNodeTest |
5 TestCase subclass:#PPCNodeTest |
6 instanceVariableNames:'node' |
6 instanceVariableNames:'node configuration' |
7 classVariableNames:'' |
7 classVariableNames:'' |
8 poolDictionaries:'' |
8 poolDictionaries:'' |
9 category:'PetitCompiler-Tests-Nodes' |
9 category:'PetitCompiler-Tests-Nodes' |
10 ! |
10 ! |
11 |
11 |
12 |
12 |
13 !PPCNodeTest methodsFor:'as yet unclassified'! |
13 !PPCNodeTest methodsFor:'as yet unclassified'! |
14 |
14 |
|
15 testAllNodesDo1 |
|
16 | node1 node2 parser allChildren | |
|
17 node1 := #letter asParser asCompilerNode. |
|
18 node2 := #letter asParser asCompilerNode. |
|
19 parser := PPChoiceParser new |
|
20 setParsers: { node1 . node2 }; |
|
21 yourself. |
|
22 |
|
23 node := PPCUnknownNode new |
|
24 parser: parser; |
|
25 yourself. |
|
26 |
|
27 self assert: node parser children first == node1. |
|
28 self assert: node parser children second == node2. |
|
29 |
|
30 allChildren := OrderedCollection new. |
|
31 node allNodesDo: [ :e | |
|
32 allChildren add: e. |
|
33 ]. |
|
34 self assert: allChildren size = 3. |
|
35 |
|
36 ! |
|
37 |
15 testCopy |
38 testCopy |
16 | newNode | |
39 | newNode | |
17 node := PPCDelegateNode new |
40 node := PPCDelegateNode new |
18 child: #foo; |
41 child: #foo; |
19 yourself. |
42 yourself. |
20 newNode := node copy. |
43 newNode := node copy. |
21 self assert: (node = newNode). |
44 self assert: (node = newNode). |
22 self assert: (node hash = newNode hash). |
45 self assert: (node hash = newNode hash). |
23 |
46 |
24 newNode child: #bar. |
47 newNode child: #bar. |
25 self assert: (node = newNode) not. |
48 self assert: (node = newNode) not. |
26 ! |
49 ! |
27 |
50 |
28 testCopy2 |
51 testCopy2 |
29 | newNode | |
52 | newNode | |
30 node := PPCSequenceNode new |
53 node := PPCSequenceNode new |
31 children: { #foo . #bar } |
54 children: { #foo . #bar } |
32 yourself. |
55 yourself. |
33 newNode := node copy. |
56 newNode := node copy. |
34 |
57 |
35 self assert: (node = newNode). |
58 self assert: (node = newNode). |
36 self assert: (node hash = newNode hash). |
59 self assert: (node hash = newNode hash). |
37 |
60 |
38 node children at: 1 put: #zorg. |
61 node children at: 1 put: #zorg. |
39 self assert: (node = newNode) not. |
62 self assert: (node = newNode) not. |
40 ! |
63 ! |
41 |
64 |
42 testCopy3 |
65 testCopy3 |
43 | newNode | |
66 | newNode | |
44 node := PPCMessagePredicateNode new |
67 node := PPCMessagePredicateNode new |
45 predicate: #block; |
68 predicate: #block; |
46 message: #message; |
69 message: #message; |
47 yourself. |
70 yourself. |
48 |
71 |
49 newNode := node copy. |
72 newNode := node copy. |
50 |
73 |
51 self assert: (node == newNode) not. |
74 self assert: (node == newNode) not. |
52 self assert: (node = newNode). |
75 self assert: (node = newNode). |
53 self assert: node hash = newNode hash. |
76 self assert: node hash = newNode hash. |
54 ! |
77 ! |
55 |
78 |
56 testCopy4 |
79 testCopy4 |
57 | node1 node2 | |
80 | node1 node2 | |
58 node1 := #letter asParser asCompilerNode. |
81 node1 := #letter asParser asCompilerNode. |
59 node2 := #letter asParser asCompilerNode. |
82 node2 := #letter asParser asCompilerNode. |
60 |
83 |
61 self assert: (node == node2) not. |
84 self assert: (node == node2) not. |
62 self assert: (node1 = node2). |
85 self assert: (node1 = node2). |
63 self assert: node1 hash = node2 hash. |
86 self assert: node1 hash = node2 hash. |
|
87 ! |
|
88 |
|
89 testCopy5 |
|
90 | node1 newNode | |
|
91 node1 := #letter asParser asCompilerNode. |
|
92 |
|
93 node := PPCUnknownNode new |
|
94 parser: node1; |
|
95 yourself. |
|
96 |
|
97 self assert: node parser == node1. |
|
98 newNode := node copy. |
|
99 self assert: (newNode parser == node1) not. |
|
100 self assert: newNode parser = node1. |
64 ! |
101 ! |
65 |
102 |
66 testEquals |
103 testEquals |
67 self assert: (PPCNode new = PPCNode new). |
104 self assert: (PPCNode new = PPCNode new). |
68 ! |
105 ! |
69 |
106 |
70 testEquals2 |
107 testEquals2 |
71 | n1 n2 n3 | |
108 | n1 n2 n3 | |
72 n1 := PPCDelegateNode new |
109 n1 := PPCDelegateNode new |
73 child: #foo; |
110 child: #foo; |
74 yourself. |
111 yourself. |
75 n2 := PPCDelegateNode new |
112 n2 := PPCDelegateNode new |
76 child: #bar; |
113 child: #bar; |
77 yourself. |
114 yourself. |
78 n3 := PPCDelegateNode new |
115 n3 := PPCDelegateNode new |
79 child: #foo; |
116 child: #foo; |
80 yourself. |
117 yourself. |
81 |
118 |
82 self assert: (n1 = n3). |
119 self assert: (n1 = n3). |
83 self assert: (n1 = n2) not. |
120 self assert: (n1 = n2) not. |
84 ! |
121 ! |
85 |
122 |
86 testReplaceNode |
123 testReplaceNode |
87 | literalNode anotherLiteralNode | |
124 | literalNode anotherLiteralNode | |
88 literalNode := PPCLiteralNode new |
125 literalNode := PPCLiteralNode new |
89 literal: 'foo'; |
126 literal: 'foo'; |
90 yourself. |
127 yourself. |
91 |
128 |
92 anotherLiteralNode := PPCLiteralNode new |
129 anotherLiteralNode := PPCLiteralNode new |
93 literal: 'bar'; |
130 literal: 'bar'; |
94 yourself. |
131 yourself. |
95 |
132 |
96 node := PPCForwardNode new |
133 node := PPCForwardNode new |
97 child: literalNode; |
134 child: literalNode; |
98 yourself. |
135 yourself. |
99 |
136 |
100 self assert: node child == literalNode. |
137 self assert: node child == literalNode. |
101 node replace: literalNode with: anotherLiteralNode. |
138 node replace: literalNode with: anotherLiteralNode. |
102 self assert: node child == anotherLiteralNode. |
139 self assert: node child == anotherLiteralNode. |
103 self assert: (node child == literalNode) not. |
140 self assert: (node child == literalNode) not. |
104 ! ! |
141 ! ! |
105 |
142 |
106 !PPCNodeTest methodsFor:'test support'! |
143 !PPCNodeTest methodsFor:'test support'! |
107 |
144 |
108 assert: object type: class |
145 assert: object type: class |
109 self assert: object class == class |
146 self assert: object class == class |
|
147 ! |
|
148 |
|
149 setUp |
|
150 configuration := PPCConfiguration default. |
|
151 configuration arguments generate: false. |
|
152 ! |
|
153 |
|
154 treeFrom: parser |
|
155 ^ parser compileWithConfiguration: configuration |
110 ! ! |
156 ! ! |
111 |
157 |
112 !PPCNodeTest methodsFor:'tests - converting'! |
158 !PPCNodeTest methodsFor:'tests - converting'! |
113 |
159 |
114 testConvertBlock |
160 testConvertBlock |
115 | parser tree | |
161 | parser tree | |
116 parser := [ :ctx | [ctx atEnd] whileFalse ] asParser. |
162 parser := [ :ctx | [ctx atEnd] whileFalse ] asParser. |
117 tree := parser asCompilerTree. |
163 tree := parser asCompilerTree. |
118 |
164 |
119 self assert: tree type: PPCPluggableNode. |
165 self assert: tree type: PPCPluggableNode. |
120 ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[ |
166 ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[ |
121 self assert: tree block asString = '[ :ctx | [ ctx atEnd ] whileFalse ]'. |
167 self assert: tree block asString = '[ :ctx | [ ctx atEnd ] whileFalse ]'. |
122 ] |
168 ] |
123 |
169 |
124 "Modified: / 05-05-2015 / 16:24:34 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
170 "Modified: / 05-05-2015 / 16:24:34 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
125 ! |
171 ! |
126 |
172 |
127 testConvertChoice |
173 testConvertChoice |
128 | parser tree | |
174 | parser tree | |
129 parser := 'foo' asParser / $b asParser. |
175 parser := 'foo' asParser / $b asParser. |
130 tree := parser asCompilerTree. |
176 tree := parser asCompilerTree. |
131 |
177 |
132 self assert: tree type: PPCChoiceNode. |
178 self assert: tree type: PPCChoiceNode. |
133 self assert: tree children size = 2. |
179 self assert: tree children size = 2. |
134 self assert: tree children first type: PPCLiteralNode. |
180 self assert: tree children first type: PPCLiteralNode. |
135 self assert: tree children second type: PPCCharacterNode. |
181 self assert: tree children second type: PPCCharacterNode. |
136 ! |
182 ! |
137 |
183 |
138 testConvertNil |
184 testConvertNil |
139 | parser tree | |
185 | parser tree | |
140 parser := nil asParser. |
186 parser := nil asParser. |
141 tree := parser asCompilerTree. |
187 tree := parser asCompilerTree. |
142 |
188 |
143 self assert: tree type: PPCNilNode. |
189 self assert: tree type: PPCNilNode. |
144 ! |
190 ! |
145 |
191 |
146 testConvertSequence |
192 testConvertSequence |
147 | parser tree | |
193 | parser tree | |
148 parser := 'foo' asParser, $b asParser. |
194 parser := 'foo' asParser, $b asParser. |
149 tree := parser asCompilerTree. |
195 tree := parser asCompilerTree. |
150 |
196 |
151 self assert: tree type: PPCSequenceNode. |
197 self assert: tree type: PPCSequenceNode. |
152 self assert: tree children size = 2. |
198 self assert: tree children size = 2. |
153 self assert: tree children first type: PPCLiteralNode. |
199 self assert: tree children first type: PPCLiteralNode. |
154 self assert: tree children second type: PPCCharacterNode. |
200 self assert: tree children second type: PPCCharacterNode. |
155 ! |
201 ! |
156 |
202 |
157 testConvertToken |
203 testConvertToken |
158 | parser tree | |
204 | parser tree | |
159 parser := 'foo' asParser token. |
205 parser := 'foo' asParser token. |
160 tree := parser asCompilerTree. |
206 tree := parser asCompilerTree. |
161 |
207 |
162 self assert: tree type: PPCTokenNode. |
208 self assert: tree type: PPCTokenNode. |
163 self assert: tree child type: PPCLiteralNode. |
209 self assert: tree child type: PPCLiteralNode. |
164 |
210 |
165 parser := ('foo' asParser, $b asParser) token. |
211 parser := ('foo' asParser, $b asParser) token. |
166 tree := parser asCompilerTree. |
212 tree := parser asCompilerTree. |
167 |
213 |
168 self assert: tree type: PPCTokenNode. |
214 self assert: tree type: PPCTokenNode. |
169 self assert: tree child type: PPCSequenceNode. |
215 self assert: tree child type: PPCSequenceNode. |
170 |
216 |
171 parser := $d asParser token star. |
217 parser := $d asParser token star. |
172 tree := parser asCompilerTree. |
218 tree := parser asCompilerTree. |
173 |
219 |
174 self assert: tree type: PPCStarNode. |
220 self assert: tree type: PPCStarNode. |
175 self assert: tree child type: PPCTokenNode. |
221 self assert: tree child type: PPCTokenNode. |
176 self assert: tree child child type: PPCCharacterNode. |
222 self assert: tree child child type: PPCCharacterNode. |
177 ! |
223 ! |
178 |
224 |
179 testConvertTrimmingToken |
225 testConvertTrimmingToken |
180 | parser tree | |
226 | parser tree | |
181 parser := 'foo' asParser trimmingToken. |
227 parser := 'foo' asParser trimmingToken. |
182 tree := parser asCompilerTree optimizeTree. |
228 tree := self treeFrom: parser. |
183 |
229 |
184 self assert: tree type: PPCTrimmingTokenNode. |
230 self assert: tree type: PPCTrimmingTokenNode. |
185 self assert: tree child type: PPCLiteralNode. |
231 self assert: tree child type: PPCLiteralNode. |
186 self assert: tree child isMarkedForInline. |
232 self assert: tree child isMarkedForInline. |
187 self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]). |
233 self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]). |
188 ! |
234 ! |
189 |
235 |
190 testConvertTrimmingToken2 |
236 testConvertTrimmingToken2 |
191 | parser tree | |
237 | parser tree | |
192 parser := ('foo' asParser, $b asParser) trimmingToken. |
238 parser := ('foo' asParser, $b asParser) trimmingToken. |
193 tree := parser asCompilerTree optimizeTree. |
239 tree := self treeFrom: parser. |
194 |
240 |
195 self assert: tree type: PPCTrimmingTokenNode. |
241 self assert: tree type: PPCTrimmingTokenNode. |
196 self assert: tree child type: PPCTokenSequenceNode. |
242 self assert: tree child type: PPCRecognizingSequenceNode. |
197 self assert: tree whitespace type: PPCTokenStarSeparatorNode. |
243 self assert: tree whitespace type: PPCTokenStarSeparatorNode. |
198 self assert: tree whitespace isMarkedForInline. |
244 self assert: tree whitespace isMarkedForInline. |
199 ! |
245 ! |
200 |
246 |
201 testConvertTrimmingToken3 |
247 testConvertTrimmingToken3 |
202 | parser tree | |
248 | parser tree | |
203 |
249 |
204 parser := $d asParser trimmingToken star. |
250 parser := $d asParser trimmingToken star. |
205 tree := parser asCompilerTree optimizeTree. |
251 tree := self treeFrom: parser. |
206 |
252 |
207 self assert: tree type: PPCStarNode. |
253 self assert: tree type: PPCStarNode. |
208 self assert: tree child type: PPCTrimmingTokenNode. |
254 self assert: tree child type: PPCTrimmingTokenNode. |
209 self assert: tree child child type: PPCCharacterNode. |
255 self assert: tree child child type: PPCCharacterNode. |
210 self assert: tree child child isMarkedForInline. |
256 self assert: tree child child isMarkedForInline. |
211 ! ! |
257 ! ! |
212 |
258 |
213 !PPCNodeTest methodsFor:'tests - epsilon'! |
259 !PPCNodeTest methodsFor:'tests - epsilon'! |
214 |
260 |
215 testActionAcceptsEpsilon |
261 testActionAcceptsEpsilon |
216 | tree | |
262 | tree | |
217 tree := ('foo' asParser token optional ==> [ :e | e ]) asCompilerTree. |
263 tree := ('foo' asParser token optional ==> [ :e | e ]) asCompilerTree. |
218 self assert: tree acceptsEpsilon. |
264 self assert: tree acceptsEpsilon. |
219 ! |
265 ! |
220 |
266 |
221 testChoiceAcceptsEpsilon |
267 testChoiceAcceptsEpsilon |
222 | tree | |
268 | tree | |
223 tree := ($a asParser / $b asParser star) asCompilerTree. |
269 tree := ($a asParser / $b asParser star) asCompilerTree. |
224 self assert: tree acceptsEpsilon. |
270 self assert: tree acceptsEpsilon. |
225 ! |
271 ! |
226 |
272 |
227 testLiteralAcceptsEpsilon |
273 testLiteralAcceptsEpsilon |
228 | tree | |
274 | tree | |
229 tree := 'foo' asParser asCompilerTree. |
275 tree := 'foo' asParser asCompilerTree. |
230 self assert: tree acceptsEpsilon not. |
276 self assert: tree acceptsEpsilon not. |
231 |
277 |
232 tree := '' asParser asCompilerTree. |
278 tree := '' asParser asCompilerTree. |
233 self assert: tree acceptsEpsilon. |
279 self assert: tree acceptsEpsilon. |
234 ! |
280 ! |
235 |
281 |
236 testPlusAcceptsEpsilon |
282 testPlusAcceptsEpsilon |
237 | tree | |
283 | tree | |
238 tree := ($b asParser plus) asCompilerTree. |
284 tree := ($b asParser plus) asCompilerTree. |
239 self assert: tree acceptsEpsilon not. |
285 self assert: tree acceptsEpsilon not. |
240 |
286 |
241 tree := #letter asParser plus asCompilerTree. |
287 tree := #letter asParser plus asCompilerTree. |
242 self assert: tree acceptsEpsilon not. |
288 self assert: tree acceptsEpsilon not. |
243 ! |
289 ! |
244 |
290 |
245 testSequenceAcceptsEpsilon |
291 testSequenceAcceptsEpsilon |
246 | tree parser | |
292 | tree parser | |
247 parser := 'foo' asParser token optional, 'bar' asParser token star, ($a asParser / $b asParser star). |
293 parser := 'foo' asParser token optional, 'bar' asParser token star, ($a asParser / $b asParser star). |
248 tree := parser asCompilerTree. |
294 tree := parser asCompilerTree. |
249 self assert: tree acceptsEpsilon. |
295 self assert: tree acceptsEpsilon. |
250 ! |
296 ! |
251 |
297 |
252 testStarAcceptsEpsilon |
298 testStarAcceptsEpsilon |
253 | tree | |
299 | tree | |
254 tree := $b asParser star asCompilerTree. |
300 tree := $b asParser star asCompilerTree. |
255 self assert: tree acceptsEpsilon. |
301 self assert: tree acceptsEpsilon. |
256 ! |
302 ! |
257 |
303 |
258 testTokenAcceptsEpsilon |
304 testTokenAcceptsEpsilon |
259 | tree | |
305 | tree | |
260 tree := ($a asParser / $b asParser plus) token asCompilerTree. |
306 tree := ($a asParser / $b asParser plus) token asCompilerTree. |
261 self assert: tree acceptsEpsilon not. |
307 self assert: tree acceptsEpsilon not. |
262 |
308 |
263 tree := ($a asParser / $b asParser star) token asCompilerTree. |
309 tree := ($a asParser / $b asParser star) token asCompilerTree. |
264 self assert: tree acceptsEpsilon. |
310 self assert: tree acceptsEpsilon. |
|
311 ! |
|
312 |
|
313 testTrimNode |
|
314 | tree | |
|
315 tree := $a asParser trim asCompilerTree. |
|
316 self assert: tree type: PPCTrimNode. |
|
317 self assert: tree child type: PPCCharacterNode. |
|
318 self assert: tree trimmer type: PPCStarNode. |
|
319 ! ! |
|
320 |
|
321 !PPCNodeTest methodsFor:'tests - recognized sentences'! |
|
322 |
|
323 assert: array anySatisfy: block |
|
324 self assert: (array anySatisfy: block) |
|
325 ! |
|
326 |
|
327 testOverlapCharacterNode |
|
328 | node1 node2 | |
|
329 node1 := $a asParser asCompilerTree. |
|
330 node2 := $b asParser asCompilerTree. |
|
331 |
|
332 self assert: (node1 overlapsWith: node2) not. |
|
333 ! |
|
334 |
|
335 testOverlapCharacterNode2 |
|
336 | node1 node2 | |
|
337 node1 := $a asParser asCompilerTree. |
|
338 node2 := $a asParser asCompilerTree. |
|
339 |
|
340 self assert: (node1 overlapsWith: node2). |
|
341 ! |
|
342 |
|
343 testOverlapNode1 |
|
344 | node1 node2 | |
|
345 node1 := $a asParser asCompilerTree. |
|
346 node2 := $a asParser asCompilerTree. |
|
347 |
|
348 self assert: (node1 overlapsWith: node2). |
|
349 ! |
|
350 |
|
351 testOverlapNode2 |
|
352 | node1 node2 | |
|
353 node1 := $a asParser asCompilerTree. |
|
354 node2 := 'a' asParser asCompilerTree. |
|
355 |
|
356 self assert: (node1 overlapsWith: node2). |
|
357 ! |
|
358 |
|
359 testOverlapNode3 |
|
360 | node1 node2 | |
|
361 node1 := ($a asParser / $b asParser) asCompilerTree. |
|
362 node2 := ('c' asParser / 'd' asParser) asCompilerTree. |
|
363 |
|
364 self assert: (node1 overlapsWith: node2) not. |
|
365 ! |
|
366 |
|
367 testOverlapNode4 |
|
368 | node1 node2 | |
|
369 node1 := ($a asParser / $b asParser) asCompilerTree. |
|
370 node2 := ('c' asParser / #any asParser) asCompilerTree. |
|
371 |
|
372 self assert: (node1 overlapsWith: node2). |
|
373 ! |
|
374 |
|
375 testOverlapNode5 |
|
376 | node1 node2 | |
|
377 node1 := ($a asParser, $b asParser) asCompilerTree. |
|
378 node2 := ('ab' asParser) asCompilerTree. |
|
379 |
|
380 self assert: (node1 overlapsWith: node2). |
|
381 ! |
|
382 |
|
383 testOverlapNode6 |
|
384 | node1 node2 | |
|
385 node1 := ($a asParser, $b asParser, $c asParser) asCompilerTree. |
|
386 node2 := ('ab' asParser) asCompilerTree. |
|
387 |
|
388 self flag: 'Not sure about this test...'. |
|
389 self assert: (node1 overlapsWith: node2) not. |
|
390 ! |
|
391 |
|
392 testOverlapNode7 |
|
393 | node1 node2 | |
|
394 node1 := ($a asParser) asCompilerTree. |
|
395 node2 := (#digit asParser) asCompilerTree. |
|
396 |
|
397 self assert: (node1 overlapsWith: node2) not. |
|
398 ! |
|
399 |
|
400 testOverlapNode8 |
|
401 | node1 node2 | |
|
402 node1 := ($a asParser) asCompilerTree. |
|
403 node2 := (#digit asParser plus) asCompilerTree. |
|
404 |
|
405 self assert: (node1 overlapsWith: node2) not. |
|
406 ! |
|
407 |
|
408 testOverlapNode9 |
|
409 | node1 node2 | |
|
410 node1 := ($a asParser) asCompilerTree. |
|
411 node2 := (#letter asParser plus) asCompilerTree. |
|
412 |
|
413 self assert: (node1 overlapsWith: node2). |
|
414 ! |
|
415 |
|
416 testOverlapTokenNode |
|
417 | node1 node2 | |
|
418 node1 := $a asParser token asCompilerTree. |
|
419 node2 := $b asParser token asCompilerTree. |
|
420 |
|
421 self assert: (node1 overlapsWith: node2) not. |
|
422 ! |
|
423 |
|
424 testOverlapTokenNode2 |
|
425 | node1 node2 | |
|
426 node1 := $a asParser token asCompilerTree. |
|
427 node2 := $a asParser token asCompilerTree. |
|
428 |
|
429 self assert: (node1 overlapsWith: node2). |
|
430 ! |
|
431 |
|
432 testOverlapTrimmingTokenNode |
|
433 | node1 node2 | |
|
434 node1 := $a asParser token trim asCompilerTree. |
|
435 node2 := $b asParser token trim asCompilerTree. |
|
436 |
|
437 self assert: (node1 overlapsWith: node2) not. |
|
438 ! |
|
439 |
|
440 testOverlapTrimmingTokenNode1 |
|
441 | node1 node2 | |
|
442 node1 := PPCTrimmingTokenNode new |
|
443 child: (PPCCharacterNode new character: $a; yourself); |
|
444 yourself. |
|
445 node2 := PPCTrimmingTokenNode new |
|
446 child: (PPCCharacterNode new character: $b; yourself); |
|
447 yourself. |
|
448 |
|
449 self assert: (node1 overlapsWith: node2) not. |
|
450 ! |
|
451 |
|
452 testOverlapTrimmingTokenNode2 |
|
453 | node1 node2 | |
|
454 node1 := PPCTrimmingTokenNode new |
|
455 child: (PPCCharacterNode new character: $a; yourself); |
|
456 yourself. |
|
457 node2 := PPCTrimmingTokenNode new |
|
458 child: (PPCCharacterNode new character: $a; yourself); |
|
459 yourself. |
|
460 |
|
461 self assert: (node1 overlapsWith: node2). |
|
462 ! |
|
463 |
|
464 testRSCharacterNode |
|
465 | sentences | |
|
466 node := PPCCharacterNode new |
|
467 character: $f; |
|
468 yourself. |
|
469 |
|
470 self assert: node hasFiniteLanguage. |
|
471 |
|
472 sentences := node recognizedSentences. |
|
473 self assert: sentences size = 1. |
|
474 self assert: sentences anyOne = 'f'. |
|
475 ! |
|
476 |
|
477 testRSChoiceNode |
|
478 | sentences | |
|
479 node := ('a' asParser / 'b' asParser) asCompilerTree. |
|
480 |
|
481 self assert: node hasFiniteLanguage. |
|
482 |
|
483 sentences := node recognizedSentences. |
|
484 self assert: sentences size = 2. |
|
485 self assert: sentences anySatisfy: [ :e | e = 'a' ]. |
|
486 self assert: sentences anySatisfy: [ :e | e = 'b' ]. |
|
487 ! |
|
488 |
|
489 testRSChoiceNode2 |
|
490 | sentences | |
|
491 node := ('a' asParser / 'a' asParser) asCompilerTree. |
|
492 |
|
493 self assert: node hasFiniteLanguage. |
|
494 |
|
495 sentences := node recognizedSentences. |
|
496 self assert: sentences size = 1. |
|
497 self assert: sentences anySatisfy: [ :e | e = 'a' ]. |
|
498 ! |
|
499 |
|
500 testRSLiteralNode |
|
501 | sentences | |
|
502 node := PPCLiteralNode new |
|
503 literal: 'foo'; |
|
504 yourself. |
|
505 self assert: node hasFiniteLanguage. |
|
506 |
|
507 sentences := node recognizedSentences. |
|
508 self assert: sentences size = 1. |
|
509 self assert: sentences anyOne = 'foo'. |
|
510 ! |
|
511 |
|
512 testRSPredicateNode |
|
513 | sentences | |
|
514 node := PPCPredicateNode new |
|
515 predicate: (PPCharSetPredicate on: [:e | e isDigit]); |
|
516 yourself. |
|
517 |
|
518 self assert: node hasFiniteLanguage. |
|
519 |
|
520 sentences := node recognizedSentences. |
|
521 self assert: sentences size = 10. |
|
522 self assert: sentences anySatisfy: [ :e | e = '0' ]. |
|
523 ! |
|
524 |
|
525 testRSSequenceNode |
|
526 | sentences | |
|
527 node := ('a' asParser, 'b' asParser) asCompilerTree. |
|
528 |
|
529 self assert: node hasFiniteLanguage. |
|
530 |
|
531 sentences := node recognizedSentences. |
|
532 self assert: sentences size = 1. |
|
533 self assert: sentences anySatisfy: [ :e | e = 'ab' ]. |
|
534 ! |
|
535 |
|
536 testRSSequenceNode2 |
|
537 | sentences | |
|
538 node := ('a' asParser, ('b' asParser / 'c' asParser)) asCompilerTree. |
|
539 |
|
540 self assert: node hasFiniteLanguage. |
|
541 |
|
542 sentences := node recognizedSentences. |
|
543 self assert: sentences size = 2. |
|
544 self assert: sentences anySatisfy: [ :e | e = 'ab' ]. |
|
545 self assert: sentences anySatisfy: [ :e | e = 'ac' ]. |
|
546 ! |
|
547 |
|
548 testRSSequenceNode3 |
|
549 | sentences | |
|
550 node := (#digit asParser, #digit asParser) asCompilerTree. |
|
551 |
|
552 self assert: node hasFiniteLanguage. |
|
553 |
|
554 sentences := node recognizedSentences. |
|
555 self assert: sentences size = 100. |
|
556 self assert: sentences anySatisfy: [ :e | e = '00' ]. |
|
557 self assert: sentences anySatisfy: [ :e | e = '99' ]. |
|
558 self assert: sentences anySatisfy: [ :e | e = '38' ]. |
|
559 |
265 ! ! |
560 ! ! |
266 |
561 |
267 !PPCNodeTest class methodsFor:'documentation'! |
562 !PPCNodeTest class methodsFor:'documentation'! |
268 |
563 |
269 version_HG |
564 version_HG |