23 ! ! |
23 ! ! |
24 |
24 |
25 !PPComposedTest methodsFor:'testing'! |
25 !PPComposedTest methodsFor:'testing'! |
26 |
26 |
27 testDoubledString |
27 testDoubledString |
28 | parser | |
28 | parser | |
29 parser := ($' asParser , (($' asParser , $' asParser) / $' asParser negate) star flatten , $' asParser) |
29 parser := ($' asParser , (($' asParser , $' asParser) / $' asParser negate) star flatten , $' asParser) |
30 ==> [ :nodes | nodes second copyReplaceAll: '''''' with: '''' ]. |
30 ==> [ :nodes | nodes second copyReplaceAll: '''''' with: '''' ]. |
31 |
31 |
32 self assert: parser parse: '''''' to: ''. |
32 self assert: parser parse: '''''' to: ''. |
33 self assert: parser parse: '''a''' to: 'a'. |
33 self assert: parser parse: '''a''' to: 'a'. |
34 self assert: parser parse: '''ab''' to: 'ab'. |
34 self assert: parser parse: '''ab''' to: 'ab'. |
35 self assert: parser parse: '''a''''b''' to: 'a''b'. |
35 self assert: parser parse: '''a''''b''' to: 'a''b'. |
36 self assert: parser parse: '''a''''''''b''' to: 'a''''b' |
36 self assert: parser parse: '''a''''''''b''' to: 'a''''b' |
37 |
|
38 "Modified: / 18-12-2010 / 18:00:16 / Jan Kurs <kurs.jan@post.cz>" |
|
39 ! |
37 ! |
40 |
38 |
41 testEvenNumber |
39 testEvenNumber |
42 "Create a grammar that parses an even number of a's and b's." |
40 "Create a grammar that parses an even number of a's and b's." |
43 |
41 |
72 |
70 |
73 testIfThenElse |
71 testIfThenElse |
74 "S ::= if C then S else S | if C then S | X" |
72 "S ::= if C then S else S | if C then S | X" |
75 |
73 |
76 | start if then else cond expr parser | |
74 | start if then else cond expr parser | |
77 start := PPUnresolvedParser new. |
75 start := PPDelegateParser new. |
78 if := 'if' asParser token trim. |
76 if := 'if' asParser token trim. |
79 then := 'then' asParser token trim. |
77 then := 'then' asParser token trim. |
80 else := 'else' asParser token trim. |
78 else := 'else' asParser token trim. |
81 cond := 'C' asParser token trim. |
79 cond := 'C' asParser token trim. |
82 expr := 'X' asParser token trim. |
80 expr := 'X' asParser token trim. |
83 start def: (if , cond , then , start , else , start) / (if , cond , then , start) / expr. |
81 start setParser: (if , cond , then , start , else , start) / (if , cond , then , start) / expr. |
84 parser := start end. |
82 parser := start end. |
85 self assert: parser parse: 'X'. |
83 self assert: parser parse: 'X'. |
86 self assert: parser parse: 'if C then X'. |
84 self assert: parser parse: 'if C then X'. |
87 self assert: parser parse: 'if C then X else X'. |
85 self assert: parser parse: 'if C then X else X'. |
88 self assert: parser parse: 'if C then if C then X'. |
86 self assert: parser parse: 'if C then if C then X'. |
96 |
94 |
97 testLeftRecursion |
95 testLeftRecursion |
98 "S ::= S 'x' S / '1'" |
96 "S ::= S 'x' S / '1'" |
99 |
97 |
100 | parser | |
98 | parser | |
101 parser := PPUnresolvedParser new. |
99 parser := PPDelegateParser new. |
102 parser def: ((parser , $x asParser , parser) / $1 asParser) memoized flatten. |
100 parser setParser: ((parser , $x asParser , parser) / $1 asParser) memoized flatten. |
103 |
101 |
104 self assert: parser parse: '1' to: '1'. |
102 self assert: parser parse: '1' to: '1'. |
105 self assert: parser parse: '1x1' to: '1x1'. |
103 self assert: parser parse: '1x1' to: '1x1'. |
106 self assert: parser parse: '1x1x1' to: '1x1x1'. |
104 self assert: parser parse: '1x1x1' to: '1x1x1'. |
107 self assert: parser parse: '1x1x1x1' to: '1x1x1x1'. |
105 self assert: parser parse: '1x1x1x1' to: '1x1x1x1'. |
111 |
109 |
112 testListOfIntegers |
110 testListOfIntegers |
113 "S ::= S , number | number" |
111 "S ::= S , number | number" |
114 |
112 |
115 | number list parser | |
113 | number list parser | |
116 number := #digit asParser plus token trim |
114 number := #digit asParser plus flatten trim |
117 ==> [ :node | node value asInteger ]. |
115 ==> [ :node | node asInteger ]. |
118 list := (number separatedBy: $, asParser token trim) |
116 list := (number separatedBy: $, asParser token trim) |
119 ==> [ :node | node select: [ :each | each isInteger ] ]. |
117 ==> [ :node | node select: [ :each | each isInteger ] ]. |
120 parser := list end. |
118 parser := list end. |
121 |
119 |
122 self assert: parser parse: '1' to: (1 to: 1) asArray. |
120 self assert: parser parse: '1' to: (1 to: 1) asArray. |
142 self assert: parser fail: '1,'. |
140 self assert: parser fail: '1,'. |
143 self assert: parser fail: '1,,2' |
141 self assert: parser fail: '1,,2' |
144 ! |
142 ! |
145 |
143 |
146 testNestedComments |
144 testNestedComments |
147 "C ::= B I* E" |
145 "C ::= B I* E" |
148 "I ::= !!E (C | T)" |
146 "I ::= !!E (C | T)" |
149 "B ::= /*" |
147 "B ::= /*" |
150 "E ::= */" |
148 "E ::= */" |
151 "T ::= ." |
149 "T ::= ." |
152 |
150 |
153 | begin end any inside parser | |
151 | begin end any inside parser | |
154 begin := '/*' asParser. |
152 begin := '/*' asParser. |
155 end := '*/' asParser. |
153 end := '*/' asParser. |
156 any := #any asParser. |
154 any := #any asParser. |
157 |
155 |
158 parser := PPUnresolvedParser new. |
156 parser := PPDelegateParser new. |
159 inside := end not , (parser / any). |
157 inside := end not , (parser / any). |
160 parser def: begin , inside star , end. |
158 parser setParser: begin , inside star , end. |
161 |
159 |
162 self assert: parser parse: '/*ab*/cd' end: 6. |
160 self assert: parser parse: '/*ab*/cd' end: 6. |
163 self assert: parser parse: '/*a/*b*/c*/'. |
161 self assert: parser parse: '/*a/*b*/c*/'. |
164 self assert: parser fail: '/*a/*b*/c' |
162 self assert: parser fail: '/*a/*b*/c' |
165 ! |
163 ! |
166 |
164 |
167 testPalindrome |
165 testPalindrome |
168 "S0 ::= a S1 a | b S1 b | ... |
166 "S0 ::= a S1 a | b S1 b | ... |
169 S1 ::= S0 | epsilon" |
167 S1 ::= S0 | epsilon" |
170 |
168 |
171 | s0 s1 parser | |
169 | s0 s1 parser | |
172 s0 := PPUnresolvedParser new. |
170 s0 := PPDelegateParser new. |
173 s1 := PPUnresolvedParser new. |
171 s1 := PPDelegateParser new. |
174 s0 def: ($a asParser , s1 , $a asParser) |
172 s0 setParser: ($a asParser , s1 , $a asParser) |
175 / ($b asParser , s1 , $b asParser) |
173 / ($b asParser , s1 , $b asParser) |
176 / ($c asParser , s1 , $c asParser). |
174 / ($c asParser , s1 , $c asParser). |
177 s1 def: s0 / nil asParser. |
175 s1 setParser: s0 / nil asParser. |
178 parser := s0 flatten end. |
176 parser := s0 flatten end. |
179 |
177 |
180 self assert: parser parse: 'aa' to: 'aa'. |
178 self assert: parser parse: 'aa' to: 'aa'. |
181 self assert: parser parse: 'bb' to: 'bb'. |
179 self assert: parser parse: 'bb' to: 'bb'. |
182 self assert: parser parse: 'cc' to: 'cc'. |
180 self assert: parser parse: 'cc' to: 'cc'. |
197 testParseAaaBbb |
195 testParseAaaBbb |
198 "S0 ::= a S1 b |
196 "S0 ::= a S1 b |
199 S1 ::= S0 | epsilon" |
197 S1 ::= S0 | epsilon" |
200 |
198 |
201 | s0 s1 parser | |
199 | s0 s1 parser | |
202 s0 := PPUnresolvedParser new. |
200 s0 := PPDelegateParser new. |
203 s1 := PPUnresolvedParser new. |
201 s1 := PPDelegateParser new. |
204 s0 def: $a asParser , s1 , $b asParser. |
202 s0 setParser: $a asParser , s1 , $b asParser. |
205 s1 def: s0 / nil asParser. |
203 s1 setParser: s0 / nil asParser. |
206 parser := s0 flatten. |
204 parser := s0 flatten. |
207 |
205 |
208 self assert: parser parse: 'ab' to: 'ab'. |
206 self assert: parser parse: 'ab' to: 'ab'. |
209 self assert: parser parse: 'aabb' to: 'aabb'. |
207 self assert: parser parse: 'aabb' to: 'aabb'. |
210 self assert: parser parse: 'aaabbb' to: 'aaabbb'. |
208 self assert: parser parse: 'aaabbb' to: 'aaabbb'. |
223 |
221 |
224 testParseAaaaaa |
222 testParseAaaaaa |
225 "S ::= a a S | epsilon" |
223 "S ::= a a S | epsilon" |
226 |
224 |
227 | s0 s1 parser | |
225 | s0 s1 parser | |
228 s0 := PPUnresolvedParser new. |
226 s0 := PPDelegateParser new. |
229 s1 := $a asParser , $a asParser , s0. |
227 s1 := $a asParser , $a asParser , s0. |
230 s0 def: s1 / nil asParser. |
228 s0 setParser: s1 / nil asParser. |
231 parser := s0 flatten. |
229 parser := s0 flatten. |
232 |
230 |
233 self assert: parser parse: '' to: ''. |
231 self assert: parser parse: '' to: ''. |
234 self assert: parser parse: 'aa' to: 'aa'. |
232 self assert: parser parse: 'aa' to: 'aa'. |
235 self assert: parser parse: 'aaaa' to: 'aaaa'. |
233 self assert: parser parse: 'aaaa' to: 'aaaa'. |
300 AB <- 'a' AB 'b' / epsilon |
298 AB <- 'a' AB 'b' / epsilon |
301 P2 <- 'a'* BC end |
299 P2 <- 'a'* BC end |
302 BC <- 'b' BC 'c' / epsilon" |
300 BC <- 'b' BC 'c' / epsilon" |
303 |
301 |
304 | s p1 ab p2 bc | |
302 | s p1 ab p2 bc | |
305 s := PPUnresolvedParser new. |
303 s := PPDelegateParser new. |
306 p1 := PPUnresolvedParser new. |
304 p1 := PPDelegateParser new. |
307 ab := PPUnresolvedParser new. |
305 ab := PPDelegateParser new. |
308 p2 := PPUnresolvedParser new. |
306 p2 := PPDelegateParser new. |
309 bc := PPUnresolvedParser new. |
307 bc := PPDelegateParser new. |
310 |
308 |
311 s def: (p1 and , p2 end) flatten. |
309 s setParser: (p1 and , p2 end) flatten. |
312 p1 def: ab , $c asParser. |
310 p1 setParser: ab , $c asParser. |
313 ab def: ($a asParser , ab , $b asParser) optional. |
311 ab setParser: ($a asParser , ab , $b asParser) optional. |
314 p2 def: $a asParser star , bc. |
312 p2 setParser: $a asParser star , bc. |
315 bc def: ($b asParser , bc , $c asParser) optional. |
313 bc setParser: ($b asParser , bc , $c asParser) optional. |
316 |
314 |
317 self assert: s parse: 'abc' to: 'abc'. |
315 self assert: s parse: 'abc' to: 'abc'. |
318 self assert: s parse: 'aabbcc' to: 'aabbcc'. |
316 self assert: s parse: 'aabbcc' to: 'aabbcc'. |
319 self assert: s parse: 'aaabbbccc' to: 'aaabbbccc'. |
317 self assert: s parse: 'aaabbbccc' to: 'aaabbbccc'. |
320 |
318 |
386 self assert: self number fail: '.1' |
384 self assert: self number fail: '.1' |
387 ! |
385 ! |
388 |
386 |
389 testReturn |
387 testReturn |
390 | number spaces return | |
388 | number spaces return | |
391 number := #digit asParser plus token. |
389 number := #digit asParser plus flatten. |
392 spaces := #space asParser star. |
390 spaces := #space asParser star. |
393 return := (spaces , $^ asParser token , spaces , number) |
391 return := (spaces , $^ asParser token , spaces , number) |
394 ==> [ :nodes | Array with: #return with: (nodes at: 4) value ]. |
392 ==> [ :nodes | Array with: #return with: (nodes at: 4) ]. |
395 |
393 |
396 self assert: return parse: '^1' to: #(return '1'). |
394 self assert: return parse: '^1' to: #(return '1'). |
397 self assert: return parse: '^12' to: #(return '12'). |
395 self assert: return parse: '^12' to: #(return '12'). |
398 self assert: return parse: '^ 123' to: #(return '123'). |
396 self assert: return parse: '^ 123' to: #(return '123'). |
399 self assert: return parse: '^ 1234' to: #(return '1234'). |
397 self assert: return parse: '^ 1234' to: #(return '1234'). |
403 ! ! |
401 ! ! |
404 |
402 |
405 !PPComposedTest class methodsFor:'documentation'! |
403 !PPComposedTest class methodsFor:'documentation'! |
406 |
404 |
407 version |
405 version |
408 ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPComposedTest.st,v 1.4 2012-12-01 15:10:15 cg Exp $' |
406 ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPComposedTest.st,v 1.5 2014-03-04 14:34:10 cg Exp $' |
409 ! |
407 ! |
410 |
408 |
411 version_CVS |
409 version_CVS |
412 ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPComposedTest.st,v 1.4 2012-12-01 15:10:15 cg Exp $' |
410 ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPComposedTest.st,v 1.5 2014-03-04 14:34:10 cg Exp $' |
413 ! |
411 ! |
414 |
412 |
415 version_SVN |
413 version_SVN |
416 ^ '§Id: PPComposedTest.st 4 2010-12-18 17:02:23Z kursjan §' |
414 ^ '$Id: PPComposedTest.st,v 1.5 2014-03-04 14:34:10 cg Exp $' |
417 ! ! |
415 ! ! |
|
416 |