1 "{ Package: 'stx:goodies/petitparser' }" |
|
2 |
|
3 PPAbstractParserTest subclass:#PPPredicateTest |
|
4 instanceVariableNames:'' |
|
5 classVariableNames:'' |
|
6 poolDictionaries:'' |
|
7 category:'PetitTests-Tests' |
|
8 ! |
|
9 |
|
10 |
|
11 !PPPredicateTest methodsFor:'private'! |
|
12 |
|
13 charactersDo: aBlock |
|
14 "cg: isn't 256 one too many?" |
|
15 |
|
16 Smalltalk isSmalltalkX ifTrue:[ |
|
17 0 to: 255 do: [ :index | aBlock value: (Character codePoint: index) ] |
|
18 ] ifFalse:[ |
|
19 1 to: 256 do: [ :index | aBlock value: (Character codePoint: index) ] |
|
20 ]. |
|
21 ! ! |
|
22 |
|
23 !PPPredicateTest methodsFor:'testing'! |
|
24 |
|
25 testOnMessage |
|
26 | block parser | |
|
27 block := [ :char | char = $* ]. |
|
28 parser := PPPredicateObjectParser on: block message: 'starlet'. |
|
29 self assert: parser block = block. |
|
30 self assert: parser message = 'starlet'. |
|
31 |
|
32 self assertCharacterSets: parser. |
|
33 self assert: parser parse: '*' to: $*. |
|
34 self assert: parser parse: '**' to: $* end: 1. |
|
35 self assert: parser fail: ''. |
|
36 self assert: parser fail: '1'. |
|
37 self assert: parser fail: 'a' |
|
38 ! ! |
|
39 |
|
40 !PPPredicateTest methodsFor:'testing-chars'! |
|
41 |
|
42 testBlank |
|
43 | parser cr| |
|
44 parser := #blank asParser. |
|
45 self assertCharacterSets: parser. |
|
46 self assert: parser parse: (String with: Character space) to: Character space. |
|
47 self assert: parser parse: (String with: Character tab) to: Character tab. |
|
48 self assert: parser fail: ''. |
|
49 self assert: parser fail: '1'. |
|
50 cr := Smalltalk isSmalltalkX |
|
51 ifTrue:[Character return] |
|
52 ifFalse:[Character cr]. |
|
53 self assert: parser fail: (String with: cr) |
|
54 ! |
|
55 |
|
56 testChar |
|
57 | parser | |
|
58 parser := $* asParser. |
|
59 self assertCharacterSets: parser. |
|
60 self assert: parser parse: '*' to: $*. |
|
61 self assert: parser parse: '**' to: $* end: 1. |
|
62 self assert: parser fail: ''. |
|
63 self assert: parser fail: '1'. |
|
64 self assert: parser fail: 'a' |
|
65 ! |
|
66 |
|
67 testCr |
|
68 | parser cr | |
|
69 |
|
70 cr := Smalltalk isSmalltalkX |
|
71 ifTrue:[Character return] |
|
72 ifFalse:[Character cr]. |
|
73 |
|
74 parser := #cr asParser. |
|
75 self assertCharacterSets: parser. |
|
76 self assert: parser parse: (String with: cr) to: cr |
|
77 ! |
|
78 |
|
79 testDigit |
|
80 | parser | |
|
81 parser := #digit asParser. |
|
82 self assertCharacterSets: parser. |
|
83 self assert: parser parse: '0' to: $0. |
|
84 self assert: parser parse: '9' to: $9. |
|
85 self assert: parser fail: ''. |
|
86 self assert: parser fail: 'a' |
|
87 ! |
|
88 |
|
89 testHex |
|
90 | parser | |
|
91 parser := #hex asParser. |
|
92 self assertCharacterSets: parser. |
|
93 self assert: parser parse: '0' to: $0. |
|
94 self assert: parser parse: '5' to: $5. |
|
95 self assert: parser parse: '9' to: $9. |
|
96 self assert: parser parse: 'A' to: $A. |
|
97 self assert: parser parse: 'D' to: $D. |
|
98 self assert: parser parse: 'F' to: $F. |
|
99 self assert: parser parse: 'a' to: $a. |
|
100 self assert: parser parse: 'e' to: $e. |
|
101 self assert: parser parse: 'f' to: $f. |
|
102 self assert: parser fail: ''. |
|
103 self assert: parser fail: 'g' |
|
104 ! |
|
105 |
|
106 testLetter |
|
107 | parser | |
|
108 parser := #letter asParser. |
|
109 self assertCharacterSets: parser. |
|
110 self assert: parser parse: 'a' to: $a. |
|
111 self assert: parser parse: 'Z' to: $Z. |
|
112 self assert: parser fail: ''. |
|
113 self assert: parser fail: '0' |
|
114 ! |
|
115 |
|
116 testLf |
|
117 | parser | |
|
118 parser := #lf asParser. |
|
119 self assertCharacterSets: parser. |
|
120 self assert: parser parse: (String with: Character lf) to: Character lf |
|
121 ! |
|
122 |
|
123 testLowercase |
|
124 | parser | |
|
125 parser := #lowercase asParser. |
|
126 self assertCharacterSets: parser. |
|
127 self assert: parser parse: 'a' to: $a. |
|
128 self assert: parser parse: 'z' to: $z. |
|
129 self assert: parser fail: ''. |
|
130 self assert: parser fail: 'A'. |
|
131 self assert: parser fail: '0' |
|
132 ! |
|
133 |
|
134 testNewline |
|
135 | parser cr| |
|
136 cr := Smalltalk isSmalltalkX |
|
137 ifTrue:[Character return] |
|
138 ifFalse:[Character cr]. |
|
139 parser := #newline asParser. |
|
140 self assertCharacterSets: parser. |
|
141 self assert: parser parse: (String with: cr) to: cr. |
|
142 self assert: parser parse: (String with: Character lf) to: Character lf. |
|
143 self assert: parser fail: ' ' |
|
144 ! |
|
145 |
|
146 testPunctuation |
|
147 | parser | |
|
148 parser := #punctuation asParser. |
|
149 self assertCharacterSets: parser. |
|
150 self assert: parser parse: '.' to: $.. |
|
151 self assert: parser parse: ',' to: $,. |
|
152 self assert: parser fail: ''. |
|
153 self assert: parser fail: 'a'. |
|
154 self assert: parser fail: '1' |
|
155 ! |
|
156 |
|
157 testSpace |
|
158 | parser | |
|
159 parser := #space asParser. |
|
160 self assertCharacterSets: parser. |
|
161 self assert: parser parse: (String with: Character tab) to: Character tab. |
|
162 self assert: parser parse: ' ' to: Character space. |
|
163 self assert: parser fail: ''. |
|
164 self assert: parser fail: 'a' |
|
165 ! |
|
166 |
|
167 testTab |
|
168 | parser | |
|
169 parser := #tab asParser. |
|
170 self assertCharacterSets: parser. |
|
171 self assert: parser parse: (String with: Character tab) to: Character tab |
|
172 ! |
|
173 |
|
174 testUppercase |
|
175 | parser | |
|
176 parser := #uppercase asParser. |
|
177 self assertCharacterSets: parser. |
|
178 self assert: parser parse: 'A' to: $A. |
|
179 self assert: parser parse: 'Z' to: $Z. |
|
180 self assert: parser fail: ''. |
|
181 self assert: parser fail: 'a'. |
|
182 self assert: parser fail: '0' |
|
183 ! |
|
184 |
|
185 testWord |
|
186 | parser | |
|
187 parser := #word asParser. |
|
188 self assertCharacterSets: parser. |
|
189 self assert: parser parse: 'a' to: $a. |
|
190 self assert: parser parse: 'A' to: $A. |
|
191 self assert: parser parse: '0' to: $0. |
|
192 self assert: parser fail: ''. |
|
193 self assert: parser fail: '-' |
|
194 ! ! |
|
195 |
|
196 !PPPredicateTest methodsFor:'testing-objects'! |
|
197 |
|
198 testAny |
|
199 | parser | |
|
200 parser := #any asParser. |
|
201 self assertCharacterSets: parser. |
|
202 self assert: parser parse: ' ' to: $ . |
|
203 self assert: parser parse: '1' to: $1. |
|
204 self assert: parser parse: 'a' to: $a. |
|
205 self assert: parser fail: '' |
|
206 ! |
|
207 |
|
208 testAnyExceptAnyOf |
|
209 | parser | |
|
210 parser := PPPredicateObjectParser anyExceptAnyOf: #($: $,). |
|
211 self assertCharacterSets: parser. |
|
212 self assert: parser parse: 'a' to: $a. |
|
213 self assert: parser parse: 'z' to: $z. |
|
214 self assert: parser fail: ':'. |
|
215 self assert: parser fail: ',' |
|
216 ! |
|
217 |
|
218 testAnyOf |
|
219 | parser | |
|
220 parser := PPPredicateObjectParser anyOf: #($a $z). |
|
221 self assertCharacterSets: parser. |
|
222 self assert: parser parse: 'a' to: $a. |
|
223 self assert: parser parse: 'z' to: $z. |
|
224 self assert: parser fail: 'x' |
|
225 ! |
|
226 |
|
227 testBetweenAnd |
|
228 | parser | |
|
229 parser := PPPredicateObjectParser between: $b and: $d. |
|
230 self assertCharacterSets: parser. |
|
231 self assert: parser fail: 'a'. |
|
232 self assert: parser parse: 'b' to: $b. |
|
233 self assert: parser parse: 'c' to: $c. |
|
234 self assert: parser parse: 'd' to: $d. |
|
235 self assert: parser fail: 'e' |
|
236 ! |
|
237 |
|
238 testExpect |
|
239 | parser | |
|
240 parser := PPPredicateObjectParser expect: $a. |
|
241 self assertCharacterSets: parser. |
|
242 self assert: parser parse: 'a' to: $a. |
|
243 self assert: parser fail: 'b'. |
|
244 self assert: parser fail: '' |
|
245 ! ! |
|
246 |
|
247 !PPPredicateTest methodsFor:'testing-sequence'! |
|
248 |
|
249 testSequenceParser |
|
250 | parser | |
|
251 parser := PPPredicateSequenceParser |
|
252 on: [ :value | value first isUppercase ] |
|
253 message: 'uppercase 3 letter words' |
|
254 size: 3. |
|
255 self assert: parser size = 3. |
|
256 self assert: parser parse: 'Abc'. |
|
257 self assert: parser parse: 'ABc'. |
|
258 self assert: parser parse: 'ABC'. |
|
259 self assert: parser fail: 'abc'. |
|
260 self assert: parser fail: 'aBC'. |
|
261 self assert: parser fail: 'Ab'. |
|
262 |
|
263 parser := parser negate. |
|
264 self assert: parser size = 3. |
|
265 self assert: parser fail: 'Abc'. |
|
266 self assert: parser fail: 'ABc'. |
|
267 self assert: parser fail: 'ABC'. |
|
268 self assert: parser parse: 'abc'. |
|
269 self assert: parser parse: 'aBC'. |
|
270 self assert: parser fail: 'Ab' |
|
271 ! ! |
|
272 |
|
273 !PPPredicateTest methodsFor:'utilities'! |
|
274 |
|
275 assertCharacterSets: aParser |
|
276 "Assert the character set of aParser does not overlap with the character set with the negated parser, and that they both cover the complete character space." |
|
277 |
|
278 | positives negatives | |
|
279 positives := self parsedCharacterSet: aParser. |
|
280 negatives := self parsedCharacterSet: aParser negate. |
|
281 self charactersDo: [ :char | |
|
282 | positive negative | |
|
283 positive := positives includes: char. |
|
284 negative := negatives includes: char. |
|
285 self |
|
286 assert: ((positive and: [ negative not ]) |
|
287 or: [ positive not and: [ negative ] ]) |
|
288 description: char printString , ' should be in exactly one set' ] |
|
289 ! |
|
290 |
|
291 parsedCharacterSet: aParser |
|
292 | result | |
|
293 result := WriteStream on: String new. |
|
294 self charactersDo: [ :char | |
|
295 (aParser matches: (String with: char)) |
|
296 ifTrue: [ result nextPut: char ] ]. |
|
297 ^ result contents |
|
298 ! ! |
|
299 |
|
300 !PPPredicateTest class methodsFor:'documentation'! |
|
301 |
|
302 version |
|
303 ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateTest.st,v 1.6 2014-03-04 20:09:46 cg Exp $' |
|
304 ! |
|
305 |
|
306 version_CVS |
|
307 ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateTest.st,v 1.6 2014-03-04 20:09:46 cg Exp $' |
|
308 ! |
|
309 |
|
310 version_SVN |
|
311 ^ '$Id: PPPredicateTest.st,v 1.6 2014-03-04 20:09:46 cg Exp $' |
|
312 ! ! |
|
313 |
|