4
|
1 |
"{ Package: 'stx:goodies/petitparser' }"
|
0
|
2 |
|
186
|
3 |
PPAbstractParserTest subclass:#PPComposedTest
|
0
|
4 |
instanceVariableNames:''
|
|
5 |
classVariableNames:''
|
|
6 |
poolDictionaries:''
|
|
7 |
category:'PetitTests-Tests'
|
|
8 |
!
|
|
9 |
|
|
10 |
|
|
11 |
!PPComposedTest methodsFor:'accessing'!
|
|
12 |
|
|
13 |
comment
|
|
14 |
^ ($" asParser , $" asParser negate star , $" asParser) flatten
|
|
15 |
!
|
|
16 |
|
|
17 |
identifier
|
|
18 |
^ (#letter asParser , #word asParser star) flatten
|
|
19 |
!
|
|
20 |
|
|
21 |
number
|
|
22 |
^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten
|
|
23 |
! !
|
|
24 |
|
|
25 |
!PPComposedTest methodsFor:'testing'!
|
|
26 |
|
|
27 |
testDoubledString
|
186
|
28 |
| parser |
|
|
29 |
parser := ($' asParser , (($' asParser , $' asParser) / $' asParser negate) star flatten , $' asParser)
|
|
30 |
==> [ :nodes | nodes second copyReplaceAll: '''''' with: '''' ].
|
0
|
31 |
|
186
|
32 |
self assert: parser parse: '''''' to: ''.
|
|
33 |
self assert: parser parse: '''a''' to: 'a'.
|
|
34 |
self assert: parser parse: '''ab''' to: 'ab'.
|
|
35 |
self assert: parser parse: '''a''''b''' to: 'a''b'.
|
|
36 |
self assert: parser parse: '''a''''''''b''' to: 'a''''b'
|
0
|
37 |
!
|
|
38 |
|
|
39 |
testEvenNumber
|
|
40 |
"Create a grammar that parses an even number of a's and b's."
|
14
|
41 |
|
0
|
42 |
| a as b bs s |
|
|
43 |
a := $a asParser ==> [ :char | as := as + 1 ].
|
|
44 |
b := $b asParser ==> [ :char | bs := bs + 1 ].
|
|
45 |
s := (a / b) star >=> [ :stream :cc |
|
|
46 |
as := bs := 0.
|
|
47 |
cc value.
|
|
48 |
(as even and: [ bs even ])
|
|
49 |
ifFalse: [ PPFailure message: 'Even number of a and b expected' at: 0 ] ].
|
|
50 |
|
|
51 |
self assert: s fail: 'a' end: 1.
|
|
52 |
self assert: s fail: 'b' end: 1.
|
|
53 |
self assert: s fail: 'ab' end: 2.
|
|
54 |
self assert: s fail: 'ba' end: 2.
|
|
55 |
self assert: s fail: 'aaa' end: 3.
|
|
56 |
self assert: s fail: 'bbb' end: 3.
|
|
57 |
self assert: s fail: 'aab' end: 3.
|
|
58 |
self assert: s fail: 'abb' end: 3.
|
14
|
59 |
|
0
|
60 |
self assert: s parse: ''.
|
|
61 |
self assert: s parse: 'aa'.
|
|
62 |
self assert: s parse: 'bb'.
|
|
63 |
self assert: s parse: 'aaaa'.
|
|
64 |
self assert: s parse: 'aabb'.
|
|
65 |
self assert: s parse: 'abab'.
|
|
66 |
self assert: s parse: 'baba'.
|
|
67 |
self assert: s parse: 'bbaa'.
|
|
68 |
self assert: s parse: 'bbbb'
|
|
69 |
!
|
|
70 |
|
|
71 |
testIfThenElse
|
|
72 |
"S ::= if C then S else S | if C then S | X"
|
|
73 |
|
|
74 |
| start if then else cond expr parser |
|
186
|
75 |
start := PPDelegateParser new.
|
0
|
76 |
if := 'if' asParser token trim.
|
|
77 |
then := 'then' asParser token trim.
|
|
78 |
else := 'else' asParser token trim.
|
|
79 |
cond := 'C' asParser token trim.
|
|
80 |
expr := 'X' asParser token trim.
|
186
|
81 |
start setParser: (if , cond , then , start , else , start) / (if , cond , then , start) / expr.
|
0
|
82 |
parser := start end.
|
|
83 |
self assert: parser parse: 'X'.
|
|
84 |
self assert: parser parse: 'if C then X'.
|
|
85 |
self assert: parser parse: 'if C then X else X'.
|
|
86 |
self assert: parser parse: 'if C then if C then X'.
|
|
87 |
self assert: parser parse: 'if C then if C then X else if C then X'.
|
|
88 |
self assert: parser parse: 'if C then if C then X else X else if C then X'.
|
|
89 |
self assert: parser parse: 'if C then if C then X else X else if C then X else X'.
|
|
90 |
self assert: parser fail: 'if C'.
|
|
91 |
self assert: parser fail: 'if C else X'.
|
|
92 |
self assert: parser fail: 'if C then if C'
|
|
93 |
!
|
|
94 |
|
|
95 |
testLeftRecursion
|
|
96 |
"S ::= S 'x' S / '1'"
|
14
|
97 |
|
0
|
98 |
| parser |
|
186
|
99 |
parser := PPDelegateParser new.
|
|
100 |
parser setParser: ((parser , $x asParser , parser) / $1 asParser) memoized flatten.
|
0
|
101 |
|
|
102 |
self assert: parser parse: '1' to: '1'.
|
|
103 |
self assert: parser parse: '1x1' to: '1x1'.
|
|
104 |
self assert: parser parse: '1x1x1' to: '1x1x1'.
|
|
105 |
self assert: parser parse: '1x1x1x1' to: '1x1x1x1'.
|
|
106 |
self assert: parser parse: '1x1x1x1x1' to: '1x1x1x1x1'.
|
|
107 |
self assert: parser parse: '1x1x1x1x1x1' to: '1x1x1x1x1x1'
|
|
108 |
!
|
|
109 |
|
|
110 |
testListOfIntegers
|
|
111 |
"S ::= S , number | number"
|
14
|
112 |
|
0
|
113 |
| number list parser |
|
186
|
114 |
number := #digit asParser plus flatten trim
|
|
115 |
==> [ :node | node asInteger ].
|
0
|
116 |
list := (number separatedBy: $, asParser token trim)
|
|
117 |
==> [ :node | node select: [ :each | each isInteger ] ].
|
|
118 |
parser := list end.
|
|
119 |
|
|
120 |
self assert: parser parse: '1' to: (1 to: 1) asArray.
|
|
121 |
self assert: parser parse: '1,2' to: (1 to: 2) asArray.
|
|
122 |
self assert: parser parse: '1,2,3' to: (1 to: 3) asArray.
|
|
123 |
self assert: parser parse: '1,2,3,4' to: (1 to: 4) asArray.
|
|
124 |
self assert: parser parse: '1,2,3,4,5' to: (1 to: 5) asArray.
|
|
125 |
|
|
126 |
self assert: parser parse: '1' to: (1 to: 1) asArray.
|
|
127 |
self assert: parser parse: '1, 2' to: (1 to: 2) asArray.
|
|
128 |
self assert: parser parse: '1, 2, 3' to: (1 to: 3) asArray.
|
|
129 |
self assert: parser parse: '1, 2, 3, 4' to: (1 to: 4) asArray.
|
|
130 |
self assert: parser parse: '1, 2, 3, 4, 5' to: (1 to: 5) asArray.
|
|
131 |
|
|
132 |
self assert: parser parse: '1' to: (1 to: 1) asArray.
|
|
133 |
self assert: parser parse: '1 ,2' to: (1 to: 2) asArray.
|
|
134 |
self assert: parser parse: '1 ,2 ,3' to: (1 to: 3) asArray.
|
|
135 |
self assert: parser parse: '1 ,2 ,3 ,4' to: (1 to: 4) asArray.
|
|
136 |
self assert: parser parse: '1 ,2 ,3 ,4 ,5' to: (1 to: 5) asArray.
|
14
|
137 |
|
0
|
138 |
self assert: parser fail: ''.
|
|
139 |
self assert: parser fail: ','.
|
|
140 |
self assert: parser fail: '1,'.
|
|
141 |
self assert: parser fail: '1,,2'
|
|
142 |
!
|
|
143 |
|
|
144 |
testNestedComments
|
186
|
145 |
"C ::= B I* E"
|
|
146 |
"I ::= !!E (C | T)"
|
|
147 |
"B ::= /*"
|
|
148 |
"E ::= */"
|
|
149 |
"T ::= ."
|
|
150 |
|
|
151 |
| begin end any inside parser |
|
|
152 |
begin := '/*' asParser.
|
|
153 |
end := '*/' asParser.
|
|
154 |
any := #any asParser.
|
|
155 |
|
|
156 |
parser := PPDelegateParser new.
|
|
157 |
inside := end not , (parser / any).
|
|
158 |
parser setParser: begin , inside star , end.
|
|
159 |
|
|
160 |
self assert: parser parse: '/*ab*/cd' end: 6.
|
|
161 |
self assert: parser parse: '/*a/*b*/c*/'.
|
|
162 |
self assert: parser fail: '/*a/*b*/c'
|
0
|
163 |
!
|
|
164 |
|
|
165 |
testPalindrome
|
|
166 |
"S0 ::= a S1 a | b S1 b | ...
|
|
167 |
S1 ::= S0 | epsilon"
|
14
|
168 |
|
0
|
169 |
| s0 s1 parser |
|
186
|
170 |
s0 := PPDelegateParser new.
|
|
171 |
s1 := PPDelegateParser new.
|
|
172 |
s0 setParser: ($a asParser , s1 , $a asParser)
|
0
|
173 |
/ ($b asParser , s1 , $b asParser)
|
14
|
174 |
/ ($c asParser , s1 , $c asParser).
|
186
|
175 |
s1 setParser: s0 / nil asParser.
|
0
|
176 |
parser := s0 flatten end.
|
|
177 |
|
|
178 |
self assert: parser parse: 'aa' to: 'aa'.
|
|
179 |
self assert: parser parse: 'bb' to: 'bb'.
|
|
180 |
self assert: parser parse: 'cc' to: 'cc'.
|
14
|
181 |
|
0
|
182 |
self assert: parser parse: 'abba' to: 'abba'.
|
|
183 |
self assert: parser parse: 'baab' to: 'baab'.
|
|
184 |
|
|
185 |
self assert: parser parse: 'abccba' to: 'abccba'.
|
|
186 |
self assert: parser parse: 'abaaba' to: 'abaaba'.
|
|
187 |
self assert: parser parse: 'cbaabc' to: 'cbaabc'.
|
|
188 |
|
|
189 |
self assert: parser fail: 'a'.
|
|
190 |
self assert: parser fail: 'ab'.
|
|
191 |
self assert: parser fail: 'aab'.
|
|
192 |
self assert: parser fail: 'abccbb'
|
|
193 |
!
|
|
194 |
|
|
195 |
testParseAaaBbb
|
|
196 |
"S0 ::= a S1 b
|
|
197 |
S1 ::= S0 | epsilon"
|
14
|
198 |
|
0
|
199 |
| s0 s1 parser |
|
186
|
200 |
s0 := PPDelegateParser new.
|
|
201 |
s1 := PPDelegateParser new.
|
|
202 |
s0 setParser: $a asParser , s1 , $b asParser.
|
|
203 |
s1 setParser: s0 / nil asParser.
|
0
|
204 |
parser := s0 flatten.
|
|
205 |
|
|
206 |
self assert: parser parse: 'ab' to: 'ab'.
|
|
207 |
self assert: parser parse: 'aabb' to: 'aabb'.
|
|
208 |
self assert: parser parse: 'aaabbb' to: 'aaabbb'.
|
|
209 |
self assert: parser parse: 'aaaabbbb' to: 'aaaabbbb'.
|
|
210 |
|
|
211 |
self assert: parser parse: 'abb' to: 'ab' end: 2.
|
|
212 |
self assert: parser parse: 'aabbb' to: 'aabb' end: 4.
|
|
213 |
self assert: parser parse: 'aaabbbb' to: 'aaabbb' end: 6.
|
|
214 |
self assert: parser parse: 'aaaabbbbb' to: 'aaaabbbb' end: 8.
|
|
215 |
|
|
216 |
self assert: parser fail: 'a'.
|
|
217 |
self assert: parser fail: 'b'.
|
|
218 |
self assert: parser fail: 'aab'.
|
|
219 |
self assert: parser fail: 'aaabb'
|
|
220 |
!
|
|
221 |
|
|
222 |
testParseAaaaaa
|
|
223 |
"S ::= a a S | epsilon"
|
14
|
224 |
|
0
|
225 |
| s0 s1 parser |
|
186
|
226 |
s0 := PPDelegateParser new.
|
0
|
227 |
s1 := $a asParser , $a asParser , s0.
|
186
|
228 |
s0 setParser: s1 / nil asParser.
|
0
|
229 |
parser := s0 flatten.
|
|
230 |
|
|
231 |
self assert: parser parse: '' to: ''.
|
|
232 |
self assert: parser parse: 'aa' to: 'aa'.
|
|
233 |
self assert: parser parse: 'aaaa' to: 'aaaa'.
|
|
234 |
self assert: parser parse: 'aaaaaa' to: 'aaaaaa'.
|
|
235 |
|
|
236 |
self assert: parser parse: 'a' to: '' end: 0.
|
|
237 |
self assert: parser parse: 'aaa' to: 'aa' end: 2.
|
|
238 |
self assert: parser parse: 'aaaaa' to: 'aaaa' end: 4.
|
|
239 |
self assert: parser parse: 'aaaaaaa' to: 'aaaaaa' end: 6
|
|
240 |
!
|
|
241 |
|
|
242 |
testParseAbAbAb
|
|
243 |
"S ::= (A B)+"
|
14
|
244 |
|
0
|
245 |
| parser |
|
|
246 |
parser := ($a asParser , $b asParser) plus flatten.
|
|
247 |
|
|
248 |
self assert: parser parse: 'ab' to: 'ab'.
|
|
249 |
self assert: parser parse: 'abab' to: 'abab'.
|
|
250 |
self assert: parser parse: 'ababab' to: 'ababab'.
|
|
251 |
self assert: parser parse: 'abababab' to: 'abababab'.
|
|
252 |
|
|
253 |
self assert: parser parse: 'abb' to: 'ab' end: 2.
|
|
254 |
self assert: parser parse: 'ababa' to: 'abab' end: 4.
|
|
255 |
self assert: parser parse: 'abababb' to: 'ababab' end: 6.
|
|
256 |
self assert: parser parse: 'ababababa' to: 'abababab' end: 8.
|
14
|
257 |
|
0
|
258 |
self assert: parser fail: ''.
|
|
259 |
self assert: parser fail: 'a'.
|
|
260 |
self assert: parser fail: 'bab'
|
|
261 |
!
|
|
262 |
|
|
263 |
testParseAbabbb
|
|
264 |
"S ::= (A | B)+"
|
|
265 |
|
|
266 |
| parser |
|
|
267 |
parser := ($a asParser / $b asParser) plus flatten.
|
|
268 |
|
|
269 |
self assert: parser parse: 'a' to: 'a'.
|
|
270 |
self assert: parser parse: 'b' to: 'b'.
|
|
271 |
self assert: parser parse: 'ab' to: 'ab'.
|
|
272 |
self assert: parser parse: 'ba' to: 'ba'.
|
|
273 |
self assert: parser parse: 'aaa' to: 'aaa'.
|
|
274 |
self assert: parser parse: 'aab' to: 'aab'.
|
|
275 |
self assert: parser parse: 'aba' to: 'aba'.
|
|
276 |
self assert: parser parse: 'baa' to: 'baa'.
|
|
277 |
self assert: parser parse: 'abb' to: 'abb'.
|
|
278 |
self assert: parser parse: 'bab' to: 'bab'.
|
|
279 |
self assert: parser parse: 'bba' to: 'bba'.
|
|
280 |
self assert: parser parse: 'bbb' to: 'bbb'.
|
|
281 |
|
|
282 |
self assert: parser parse: 'ac' to: 'a' end: 1.
|
|
283 |
self assert: parser parse: 'bc' to: 'b' end: 1.
|
|
284 |
self assert: parser parse: 'abc' to: 'ab' end: 2.
|
|
285 |
self assert: parser parse: 'bac' to: 'ba' end: 2.
|
14
|
286 |
|
0
|
287 |
self assert: parser fail: ''.
|
|
288 |
self assert: parser fail: 'c'
|
|
289 |
!
|
|
290 |
|
|
291 |
testParseAnBnCn
|
14
|
292 |
"PEGs for a non context- free language:
|
|
293 |
|
0
|
294 |
a^n , b^n , c^n
|
14
|
295 |
|
|
296 |
S <- &P1 P2
|
|
297 |
P1 <- AB 'c'
|
0
|
298 |
AB <- 'a' AB 'b' / epsilon
|
|
299 |
P2 <- 'a'* BC end
|
|
300 |
BC <- 'b' BC 'c' / epsilon"
|
14
|
301 |
|
0
|
302 |
| s p1 ab p2 bc |
|
186
|
303 |
s := PPDelegateParser new.
|
|
304 |
p1 := PPDelegateParser new.
|
|
305 |
ab := PPDelegateParser new.
|
|
306 |
p2 := PPDelegateParser new.
|
|
307 |
bc := PPDelegateParser new.
|
14
|
308 |
|
186
|
309 |
s setParser: (p1 and , p2 end) flatten.
|
|
310 |
p1 setParser: ab , $c asParser.
|
|
311 |
ab setParser: ($a asParser , ab , $b asParser) optional.
|
|
312 |
p2 setParser: $a asParser star , bc.
|
|
313 |
bc setParser: ($b asParser , bc , $c asParser) optional.
|
14
|
314 |
|
0
|
315 |
self assert: s parse: 'abc' to: 'abc'.
|
|
316 |
self assert: s parse: 'aabbcc' to: 'aabbcc'.
|
|
317 |
self assert: s parse: 'aaabbbccc' to: 'aaabbbccc'.
|
|
318 |
|
|
319 |
self assert: s fail: 'bc'.
|
|
320 |
self assert: s fail: 'ac'.
|
|
321 |
self assert: s fail: 'ab'.
|
|
322 |
self assert: s fail: 'abbcc'.
|
|
323 |
self assert: s fail: 'aabcc'.
|
|
324 |
self assert: s fail: 'aabbc'
|
|
325 |
! !
|
|
326 |
|
|
327 |
!PPComposedTest methodsFor:'testing-examples'!
|
|
328 |
|
|
329 |
testComment
|
|
330 |
self assert: self comment parse: '""' to: '""'.
|
|
331 |
self assert: self comment parse: '"a"' to: '"a"'.
|
|
332 |
self assert: self comment parse: '"ab"' to: '"ab"'.
|
|
333 |
self assert: self comment parse: '"abc"' to: '"abc"'.
|
|
334 |
|
|
335 |
self assert: self comment parse: '""a' to: '""' end: 2.
|
|
336 |
self assert: self comment parse: '"a"a' to: '"a"' end: 3.
|
|
337 |
self assert: self comment parse: '"ab"a' to: '"ab"' end: 4.
|
|
338 |
self assert: self comment parse: '"abc"a' to: '"abc"' end: 5.
|
|
339 |
|
|
340 |
self assert: self comment fail: '"'.
|
|
341 |
self assert: self comment fail: '"a'.
|
|
342 |
self assert: self comment fail: '"aa'.
|
|
343 |
self assert: self comment fail: 'a"'.
|
|
344 |
self assert: self comment fail: 'aa"'
|
|
345 |
!
|
|
346 |
|
|
347 |
testIdentifier
|
|
348 |
self assert: self identifier parse: 'a' to: 'a'.
|
|
349 |
self assert: self identifier parse: 'a1' to: 'a1'.
|
|
350 |
self assert: self identifier parse: 'a12' to: 'a12'.
|
|
351 |
self assert: self identifier parse: 'ab' to: 'ab'.
|
|
352 |
self assert: self identifier parse: 'a1b' to: 'a1b'.
|
|
353 |
|
|
354 |
self assert: self identifier parse: 'a_' to: 'a' end: 1.
|
|
355 |
self assert: self identifier parse: 'a1-' to: 'a1' end: 2.
|
|
356 |
self assert: self identifier parse: 'a12+' to: 'a12' end: 3.
|
|
357 |
self assert: self identifier parse: 'ab^' to: 'ab' end: 2.
|
|
358 |
self assert: self identifier parse: 'a1b*' to: 'a1b' end: 3.
|
|
359 |
|
|
360 |
self assert: self identifier fail: ''.
|
|
361 |
self assert: self identifier fail: '1'.
|
|
362 |
self assert: self identifier fail: '1a'
|
|
363 |
!
|
|
364 |
|
|
365 |
testNumber
|
|
366 |
self assert: self number parse: '1' to: '1'.
|
|
367 |
self assert: self number parse: '12' to: '12'.
|
|
368 |
self assert: self number parse: '12.3' to: '12.3'.
|
|
369 |
self assert: self number parse: '12.34' to: '12.34'.
|
|
370 |
|
|
371 |
self assert: self number parse: '1..' to: '1' end: 1.
|
|
372 |
self assert: self number parse: '12-' to: '12' end: 2.
|
|
373 |
self assert: self number parse: '12.3.' to: '12.3' end: 4.
|
|
374 |
self assert: self number parse: '12.34.' to: '12.34' end: 5.
|
14
|
375 |
|
0
|
376 |
self assert: self number parse: '-1' to: '-1'.
|
|
377 |
self assert: self number parse: '-12' to: '-12'.
|
|
378 |
self assert: self number parse: '-12.3' to: '-12.3'.
|
|
379 |
self assert: self number parse: '-12.34' to: '-12.34'.
|
14
|
380 |
|
0
|
381 |
self assert: self number fail: ''.
|
|
382 |
self assert: self number fail: '-'.
|
|
383 |
self assert: self number fail: '.'.
|
|
384 |
self assert: self number fail: '.1'
|
|
385 |
!
|
|
386 |
|
|
387 |
testReturn
|
|
388 |
| number spaces return |
|
186
|
389 |
number := #digit asParser plus flatten.
|
0
|
390 |
spaces := #space asParser star.
|
|
391 |
return := (spaces , $^ asParser token , spaces , number)
|
186
|
392 |
==> [ :nodes | Array with: #return with: (nodes at: 4) ].
|
0
|
393 |
|
|
394 |
self assert: return parse: '^1' to: #(return '1').
|
|
395 |
self assert: return parse: '^12' to: #(return '12').
|
|
396 |
self assert: return parse: '^ 123' to: #(return '123').
|
|
397 |
self assert: return parse: '^ 1234' to: #(return '1234').
|
14
|
398 |
|
0
|
399 |
self assert: return fail: '1'.
|
|
400 |
self assert: return fail: '^'
|
|
401 |
! !
|
|
402 |
|
|
403 |
!PPComposedTest class methodsFor:'documentation'!
|
|
404 |
|
14
|
405 |
version
|
186
|
406 |
^ '$Header: /cvs/stx/stx/goodies/petitparser/PPComposedTest.st,v 1.5 2014-03-04 14:34:10 cg Exp $'
|
14
|
407 |
!
|
|
408 |
|
|
409 |
version_CVS
|
186
|
410 |
^ '$Header: /cvs/stx/stx/goodies/petitparser/PPComposedTest.st,v 1.5 2014-03-04 14:34:10 cg Exp $'
|
14
|
411 |
!
|
|
412 |
|
0
|
413 |
version_SVN
|
186
|
414 |
^ '$Id: PPComposedTest.st,v 1.5 2014-03-04 14:34:10 cg Exp $'
|
0
|
415 |
! !
|
186
|
416 |
|