Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Test parser infrastructure | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This file is part of the Sensble Object Design, an object system for C. | |
11 | ;;; | |
12 | ;;; SOD is free software; you can redistribute it and/or modify | |
13 | ;;; it under the terms of the GNU General Public License as published by | |
14 | ;;; the Free Software Foundation; either version 2 of the License, or | |
15 | ;;; (at your option) any later version. | |
16 | ;;; | |
17 | ;;; SOD is distributed in the hope that it will be useful, | |
18 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;;; GNU General Public License for more details. | |
21 | ;;; | |
22 | ;;; You should have received a copy of the GNU General Public License | |
23 | ;;; along with SOD; if not, write to the Free Software Foundation, | |
24 | ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
25 | ||
26 | (cl:in-package #:sod-test) | |
27 | ||
28 | (defclass test-parser (test-case) | |
29 | ()) | |
30 | (add-test *sod-test-suite* (get-suite test-parser)) | |
31 | ||
32 | ;;;-------------------------------------------------------------------------- | |
33 | ;;; Utilities. | |
34 | ||
35 | (defmacro assert-parse | |
36 | ((string value winp consumedp &key (scanner (gensym "SCANNER-"))) | |
37 | &body parser) | |
38 | (once-only (string value winp consumedp) | |
39 | (with-gensyms (my-value my-winp my-consumedp label what) | |
40 | `(let ((,scanner (make-string-scanner ,string))) | |
41 | (multiple-value-bind (,my-value ,my-winp ,my-consumedp) | |
42 | (with-parser-context | |
43 | (character-scanner-context :scanner ,scanner) | |
44 | (parse ,@parser)) | |
45 | (flet ((,label (,what) | |
46 | (format nil "~A; parsing ~S with ~S" | |
47 | ,what ,string ',@parser))) | |
48 | (cond (,winp | |
49 | (assert-true ,my-winp (,label "winp")) | |
50 | (if (eq ,value t) | |
51 | (assert-not-eql ,my-value nil | |
52 | (,label "parser result")) | |
53 | (assert-equal ,my-value ,value | |
54 | (,label "parser result")))) | |
55 | (t | |
56 | (assert-false ,my-winp (,label "winp")) | |
57 | (assert-true (and (null (set-difference ,my-value ,value | |
58 | :test #'equal)) | |
59 | (null (set-difference ,value ,my-value | |
60 | :test #'equal))) | |
61 | (,label "failure indicator")))) | |
62 | (if ,consumedp | |
63 | (assert-true ,my-consumedp (,label "consumedp")) | |
64 | (assert-false ,my-consumedp (,label "consumedp"))))))))) | |
65 | ||
66 | ;;;-------------------------------------------------------------------------- | |
67 | ;;; Simple parser tests. | |
68 | ;;; | |
69 | ;;; This lot causes SBCL to warn like a mad thing. It's too clever for us, | |
70 | ;;; and does half of the work at compile time! | |
71 | ||
72 | (def-test-method test-simple ((test test-parser) :run nil) | |
73 | "Test simple atomic parsers, because we rely on them later." | |
74 | ||
75 | ;; Characters match themselves. For a character known only at run-time, | |
76 | ;; use (char CH). | |
77 | (assert-parse ("abcd" #\a t t) #\a) | |
78 | (let ((ch #\b)) | |
79 | (assert-parse ("abcd" '(#\b) nil nil) (char ch))) | |
80 | ||
81 | ;; A character can't match at EOF. | |
82 | (assert-parse ("" '(#\z) nil nil) #\z) | |
83 | ||
84 | ;; All characters match :any; but EOF isn't a character. | |
85 | (assert-parse ("z" #\z t t) :any) | |
86 | (assert-parse ("" '(:any) nil nil) :any) | |
87 | ||
88 | ;; The parser (satisfies PREDICATE) succeeds if the PREDICATE returns | |
89 | ;; true when applied to the current character. | |
90 | (assert-parse ("a" #\a t t) (satisfies alpha-char-p)) | |
91 | (assert-parse ("0" '(alpha-char-p) nil nil) (satisfies alpha-char-p)) | |
92 | ||
93 | ;; The parser (not CHAR) matches a character other than CHAR; but it won't | |
94 | ;; match EOF. | |
95 | (assert-parse ("a" #\a t t) (not #\b)) | |
96 | (assert-parse ("b" '((not #\b)) nil nil) (not #\b)) | |
97 | (assert-parse ("" '((not #\b)) nil nil) (not #\b)) | |
98 | ||
99 | ;; But :eof matches only at EOF. | |
100 | (assert-parse ("" :eof t nil) :eof) | |
101 | (assert-parse ("abcd" '(:eof) nil nil) :eof) | |
102 | ||
103 | ;; Strings match themselves without consuming if they fail. | |
104 | (assert-parse ("abcd" "ab" t t) "ab") | |
105 | (assert-parse ("abcd" '("cd") nil nil) "cd")) | |
106 | ||
107 | (def-test-method test-sequence ((test test-parser) :run nil) | |
108 | ||
109 | ;; An empty sequence always succeeds and never consumes. And provokes | |
110 | ;; warnings: don't do this. | |
111 | (assert-parse ("" :win t nil) (seq () :win)) | |
112 | (assert-parse ("abcd" :win t nil) (seq () :win)) | |
113 | ||
114 | ;; A `seq' matches the individual parsers in order, and binds their results | |
115 | ;; to variables -- if given. The result is the value of the body. If any | |
116 | ;; parser fails having consumed input, then input stays consumed. There's | |
117 | ;; no backtracking. | |
118 | (assert-parse ("abcd" '(#\a . #\c) t t) | |
119 | (seq ((foo #\a) #\b (bar #\c)) (cons foo bar))) | |
120 | (assert-parse ("abcd" '(#\c) nil t) | |
121 | (seq ((foo #\a) (bar #\c)) (cons foo bar))) | |
122 | (assert-parse ("abcd" '(#\c) nil nil) | |
123 | (seq ((bar #\c) (foo #\a)) (cons foo bar)))) | |
124 | ||
125 | (def-test-method test-repeat ((test test-parser) :run nil) | |
126 | ||
127 | ;; A `many' matches a bunch of similar things in a row. You can compute a | |
128 | ;; result using `do'-like accumulation. | |
129 | (assert-parse ("aaaab" 4 t t) (many (acc 0 (1+ acc)) #\a)) | |
130 | ||
131 | ;; The default minimum is zero; so the parser always succeeds. | |
132 | (assert-parse ("aaaab" 0 t nil) (many (acc 0 (1+ acc)) #\b)) | |
133 | ||
134 | ;; You can provide an explicit minimum. Then the match might fail. | |
135 | (assert-parse ("aabb" 2 t t) (many (acc 0 (1+ acc) :min 2) #\a)) | |
136 | (assert-parse ("aabb" '(#\a) nil t) (many (acc 0 (1+ acc) :min 3) #\a)) | |
137 | ||
138 | ;; You can also provide an explicit maximum. This will cause the parser to | |
139 | ;; stop searching, but it can't make it fail. | |
140 | (assert-parse ("aaaab" 3 t t) (many (acc 0 (1+ acc) :max 3) #\a)) | |
141 | ||
142 | ;; You can provide both a maximum and a minimum at the same time. If | |
143 | ;; they're consistent, you won't be surprised. If they aren't, then the | |
144 | ;; maximum wins and the minimum is simply ignored (currently). | |
145 | (assert-parse ("aaaaab" 4 t t) | |
146 | (many (acc 0 (1+ acc) :min 3 :max 4) #\a)) | |
147 | (assert-parse ("aabbbb" '(#\a) nil t) | |
148 | (many (acc 0 (1+ acc) :min 3 :max 4) #\a)) | |
149 | (assert-parse ("aaabbb" 3 t t) | |
150 | (many (acc 0 (1+ acc) :min 3 :max 3) #\a)) | |
151 | (assert-parse ("aaabbb" 3 t t) | |
152 | (many (acc 0 (1+ acc) :min 17 :max 3) #\a)) | |
153 | ||
154 | ;; You can provide a separator. The `many' parser will look for the | |
155 | ;; separator between each of the main items, but will ignore the results. | |
156 | (assert-parse ("a,a,abc" 3 t t) (many (acc 0 (1+ acc)) #\a #\,)) | |
157 | (assert-parse ("a,a,abc" 2 t t) (many (acc 0 (1+ acc) :max 2) #\a #\,)) | |
158 | ||
159 | ;; If `many' sees a separator then by default it commits to finding another | |
160 | ;; item; so this can cause a parse to fail. | |
161 | (assert-parse ("a,a,bc" '(#\a) nil t) (many (acc 0 (1+ acc)) #\a #\,)) | |
162 | (assert-parse ("abc" 1 t t) (many (acc 0 (1+ acc)) #\a #\,)) | |
163 | ||
164 | ;; If you specify a separator then the default minimum number of | |
165 | ;; repetitions becomes 1 rather than 0. But you can override this | |
166 | ;; explicitly. | |
167 | (assert-parse ("bc" '(#\a) nil nil) (many (acc 0 (1+ acc)) #\a #\,)) | |
168 | (assert-parse ("bc" 0 t nil) (many (acc 0 (1+ acc) :min 0) #\a #\,)) | |
169 | ||
170 | ;; The parser will fail looking for a separator if there aren't enough | |
171 | ;; items. | |
172 | (assert-parse ("a,abc" '(#\,) nil t) | |
173 | (many (acc 0 (1+ acc) :min 3) #\a #\,)) | |
174 | ||
175 | ;; You can override the commit-on-separator behaviour by using :commit. | |
176 | ;; This makes a trailing separator legal (but optional), so it also affects | |
177 | ;; the behaviour regarding maximum and minimum repetitions. (Commitment is | |
178 | ;; irrelevant if you don't have a separator.) | |
179 | (assert-parse ("a,a,bc" 2 t t) | |
180 | (many (acc 0 (1+ acc) :commitp nil) #\a #\,)) | |
181 | (assert-parse ("a,a,abc" 3 t t) | |
182 | (many (acc 0 (1+ acc) :commitp nil) #\a #\,)) | |
183 | (assert-parse ("a,a,a,bc" 3 t t) | |
184 | (seq ((n (many (acc 0 (1+ acc) :max 3 :commitp t) #\a #\,)) | |
185 | #\,) | |
186 | n)) | |
187 | (assert-parse ("a,a,a,bc" 3 t t) | |
188 | (seq ((n (many (acc 0 (1+ acc) :max 3 :commitp nil) #\a #\,)) | |
189 | #\b) | |
190 | n)) | |
191 | (assert-parse ("a,a,bc" '(#\a) nil t) | |
192 | (many (acc 0 (1+ acc) :min 3 :commitp nil) #\a #\,)) | |
193 | ||
194 | ;; The `many' parser won't backtrack. The `many' eats as many `a's as | |
195 | ;; possible; asking for another one is sure to fail. | |
196 | (assert-parse ("aaaabc" '(#\a) nil t) (and (skip-many () #\a) #\a))) | |
197 | ||
198 | (def-test-method test-repeat-hairy ((test test-parser) :run nil) | |
199 | ;; The `many' expander is very hairy and does magical things if it notices | |
200 | ;; that some of its arguments are constants. So here we test a number of | |
201 | ;; the above things again, using variables so that it has to produce code | |
202 | ;; which makes decisions at run-time. (I've no doubt that SBCL will issue | |
203 | ;; an infinite number of notes explaining how clever it is and how it can | |
204 | ;; do it all at compile-time anyway. Of course, suppressing these notes is | |
205 | ;; the main reason `many' is so hairy anyway.) | |
206 | ||
207 | (let ((zero 0) (two 2) (three 3) (yes t) (no nil)) | |
208 | ||
209 | ;; Minima. | |
210 | (assert-parse ("aaaab" 4 t t) (many (acc 0 (1+ acc) :min zero) #\a)) | |
211 | (assert-parse ("aaaab" 0 t nil) (many (acc 0 (1+ acc) :min zero) #\b)) | |
212 | (assert-parse ("aabb" 2 t t) (many (acc 0 (1+ acc) :min two) #\a)) | |
213 | (assert-parse ("aabb" '(#\a) nil t) | |
214 | (many (acc 0 (1+ acc) :min three) #\a)) | |
215 | ||
216 | ;; Maxima. | |
217 | (assert-parse ("aaaab" 4 t t) (many (acc 0 (1+ acc) :max no) #\a)) | |
218 | (assert-parse ("aaaab" 3 t t) (many (acc 0 (1+ acc) :max three) #\a)) | |
219 | ||
220 | ;; And now together with separators and commitment. Oh, my. | |
221 | (assert-parse ("a,a,a,bc" 3 t t) | |
222 | (many (acc 0 (1+ acc) :commitp no) #\a #\,)) | |
223 | (assert-parse ("a,a,a,bc" '(#\a) nil t) | |
224 | (many (acc 0 (1+ acc) :commitp yes) #\a #\,)) | |
225 | (assert-parse ("a,a,bc" '(#\a) nil t) | |
226 | (many (acc 0 (1+ acc) :min three :commitp yes) #\a #\,)) | |
227 | (assert-parse ("a,a,bc" '(#\a) nil t) | |
228 | (many (acc 0 (1+ acc) :min 3 :commitp yes) #\a #\,)) | |
229 | (assert-parse ("a,a,bc" '(#\a) nil t) | |
230 | (many (acc 0 (1+ acc) :min three :commitp t) #\a #\,)) | |
231 | (assert-parse ("a,a,a,bc" 3 t t) | |
232 | (seq ((n (many (acc 0 (1+ acc) :max three :commitp no) #\a #\,)) #\b) | |
233 | n)) | |
234 | (assert-parse ("a,a,a,bc" 3 t t) | |
235 | (seq ((n (many (acc 0 (1+ acc) :max three :commitp yes) #\a #\,)) #\,) | |
236 | n)) | |
237 | (assert-parse ("a,a,a,bc" 3 t t) | |
238 | (seq ((n (many (acc 0 (1+ acc) :max 3 :commitp no) #\a #\,)) #\b) | |
239 | n)) | |
240 | (assert-parse ("a,a,a,bc" 3 t t) | |
241 | (seq ((n (many (acc 0 (1+ acc) :max 3 :commitp yes) #\a #\,)) #\,) | |
242 | n)) | |
243 | (assert-parse ("a,a,a,bc" 3 t t) | |
244 | (seq ((n (many (acc 0 (1+ acc) :max three :commitp nil) #\a #\,)) #\b) | |
245 | n)) | |
246 | (assert-parse ("a,a,a,bc" 3 t t) | |
247 | (seq ((n (many (acc 0 (1+ acc) :max three :commitp t) #\a #\,)) #\,) | |
248 | n)))) | |
249 | ||
250 | (def-test-method test-alternate ((test test-parser) :run nil) | |
251 | ||
252 | ;; An `or' matches the first parser that either succeeds or fails having | |
253 | ;; consumed input. | |
254 | (assert-parse ("abcd" #\a t t) (or #\a #\b)) | |
255 | (assert-parse ("abcd" #\a t t) (or #\b #\a)) | |
256 | (assert-parse ("abcd" '(#\b #\c) nil nil) (or #\b #\c)) | |
257 | ||
258 | ;; Strings don't consume if they fail. | |
259 | (assert-parse ("abcd" "ab" t t) (or "cd" "ab")) | |
260 | (assert-parse ("abcd" "ab" t t) (or "ad" "ab")) | |
261 | (assert-parse ("abcd" '("ad" "ac") nil nil) (or "ad" "ac")) | |
262 | ||
263 | ;; But `seq' will if some component consumes. | |
264 | (assert-parse ("abcd" '(#\d) nil t) (or (and #\a #\d) "ab")) | |
265 | (assert-parse ("abcd" "ab" t t) (or (and #\c #\d) "ab")) | |
266 | ||
267 | ;; We can tame this using `peek' which rewinds the source if its argument | |
268 | ;; fails, so as to hide consumption of input. | |
269 | (assert-parse ("abcd" "ab" t t) (or (peek (and #\a #\d)) "ab")) | |
270 | (assert-parse ("abcd" '(#\a #\b "cd") t t) | |
271 | (seq ((foo (peek (seq ((foo #\a) (bar #\b)) (list foo bar)))) | |
272 | (bar "cd")) | |
273 | (append foo (list bar)))) | |
274 | ||
275 | ;; Failure indicators are union'd if they all fail. | |
276 | (assert-parse ("abcd" '(#\q #\x #\z) nil nil) | |
277 | (or #\q (peek (and #\a (or #\x #\q))) #\z)) | |
278 | ||
279 | ;; But if any of them consumed input then you only get the indicators from | |
280 | ;; the consuming branch, because we committed to it when we consumed the | |
281 | ;; input. | |
282 | (assert-parse ("abcd" '(#\x #\q) nil t) | |
283 | (or #\q #\z (and #\a (or #\q #\x))))) | |
284 | ||
285 | ;;;-------------------------------------------------------------------------- | |
286 | ;;; Some tests with a simple recursive parser. | |
287 | ||
288 | (defstruct (node | |
289 | (:predicate nodep) | |
290 | (:constructor make-node (left data right))) | |
291 | "Structure type for a simple binary tree." | |
292 | left data right) | |
293 | ||
294 | (defun parse-tree (scanner) | |
295 | "Parse a textual representation into a simple binary tree. | |
296 | ||
297 | The syntax is simple: | |
298 | ||
299 | TREE ::= EMPTY | `(' TREE CHAR TREE `)' | |
300 | ||
301 | There's an ambiguity in this syntax, at least if you have limited | |
302 | lookahead: suppose you've just parsed the opening `(' of a TREE, and you | |
303 | see another `(' -- is it the start of the non-empty left sub-TREE, or is | |
304 | it the CHAR following an empty left sub-TREE? We opt for the first choice | |
305 | always." | |
306 | ||
307 | ;; This came from another project, although it isn't actually used there. | |
308 | ;; It exposed the weakness in an earlier design which prompted the addition | |
309 | ;; of the CONSUMEDP flags to the parser protocol. | |
310 | ||
311 | (with-parser-context (character-scanner-context :scanner scanner) | |
312 | (labels ((tree () | |
313 | (parse (or (seq (#\( | |
314 | (left (tree)) | |
315 | (data :any) | |
316 | (right (tree)) | |
317 | #\)) | |
318 | (make-node left data right)) | |
319 | (values nil t nil))))) | |
320 | (parse (seq ((tree (tree)) :eof) | |
321 | tree))))) | |
322 | ||
323 | (defun parse-tree-lookahead (scanner) | |
324 | "Parse a textual representation into a simple binary tree. | |
325 | ||
326 | The syntax is simple, and, indeed, the grammar's the same as for | |
327 | `sod-parse-tree': | |
328 | ||
329 | TREE ::= EMPTY | `(' TREE CHAR TREE `)' | |
330 | ||
331 | But the rules are different. Instead of resolving the `ambiguity' between | |
332 | TREE and CHAR when we find another `(' after the opening `(' of a TREE | |
333 | deterministically in favour of TREE as `parse-tree' does, we try that | |
334 | first, and backtrack if necessary." | |
335 | ||
336 | ;; Bison can do this, but you have to persuade it to use the scary GLR | |
337 | ;; parser algorithm | |
338 | ||
339 | (with-parser-context (character-scanner-context :scanner scanner) | |
340 | (labels ((tree () | |
341 | (parse (or (peek (seq (#\( | |
342 | (left (tree)) | |
343 | (data :any) | |
344 | (right (tree)) | |
345 | #\)) | |
346 | (make-node left data right))) | |
347 | (values nil t nil))))) | |
348 | (parse (seq ((tree (tree)) :eof) | |
349 | tree))))) | |
350 | ||
351 | (def-test-method test-simple-tree-parser ((test test-parser) :run nil) | |
352 | (assert-parse ("" nil t nil :scanner sc) (parse-tree sc)) | |
353 | (assert-parse ("((a)b((c)d(e)))" t t t :scanner sc) (parse-tree sc)) | |
354 | (assert-parse ("((a)b((c)d(e)))z" '(:eof) nil t :scanner sc) | |
355 | (parse-tree sc)) | |
356 | (assert-parse ("((a)b((c)d(e))" '(#\)) nil t :scanner sc) (parse-tree sc)) | |
357 | (assert-parse ("(([)*(]))" t t t :scanner sc) (parse-tree sc)) | |
358 | (assert-parse ("((()-()))" '(#\)) nil t :scanner sc) (parse-tree sc)) | |
359 | (assert-parse ("((()-()))" t t t :scanner sc) (parse-tree-lookahead sc))) | |
360 | ||
361 | ;;;-------------------------------------------------------------------------- | |
362 | ;;; Test expression parser. | |
363 | ||
8d1d7d3e MW |
364 | (eval-when (:compile-toplevel :load-toplevel :execute) |
365 | (defparse token (:context (context character-parser-context) parser) | |
366 | (with-gensyms (value) | |
367 | (expand-parser-spec context | |
368 | `(seq ((,value ,parser) :whitespace) ,value))))) | |
dea4d055 MW |
369 | |
370 | (let ((add (binop "+" (x y 5) `(+ ,x ,y))) | |
371 | (sub (binop "-" (x y 5) `(- ,x ,y))) | |
372 | (mul (binop "*" (x y 7) `(* ,x ,y))) | |
373 | (div (binop "/" (x y 7) `(/ ,x ,y))) | |
374 | (eq (binop "=" (x y 3 :assoc nil) `(= ,x ,y))) | |
375 | (ne (binop "/=" (x y 3 :assoc nil) `(/= ,x ,y))) | |
376 | (lt (binop "<" (x y 3 :assoc nil) `(< ,x ,y))) | |
377 | (gt (binop ">" (x y 3 :assoc nil) `(> ,x ,y))) | |
378 | (and (binop "&" (x y 2) `(and ,x ,y))) | |
379 | (or (binop "|" (x y 1) `(or ,x ,y))) | |
380 | (expt (binop "**" (x y 8 :assoc :right) `(** ,x ,y))) | |
381 | (neg (preop "-" (x 9) `(- ,x))) | |
382 | (not (preop "!" (x 2) `(not ,x))) | |
383 | (fact (postop "!" (x 10) `(! ,x))) | |
384 | (lp (lparen #\))) (rp (rparen #\))) | |
385 | (lb (lparen #\])) (rb (rparen #\]))) | |
386 | (defun test-parse-expr (string) | |
387 | (with-parser-context (string-parser :string string) | |
388 | (parse (seq (:whitespace | |
389 | (value (expr (:nestedp nestedp) | |
390 | (token (many (a 0 (+ (* a 10) it) :min 1) | |
391 | (filter digit-char-p))) | |
392 | (token (or (seq ("**") expt) | |
393 | (seq ("/=") ne) | |
394 | (seq (#\+) add) | |
395 | (seq (#\-) sub) | |
396 | (seq (#\*) mul) | |
397 | (seq (#\/) div) | |
398 | (seq (#\=) eq) | |
399 | (seq (#\<) lt) | |
400 | (seq (#\>) gt) | |
401 | (seq (#\&) and) | |
402 | (seq (#\|) or))) | |
403 | (token (or (seq (#\() lp) | |
239fa5bd | 404 | (seq (#\[) lb) |
dea4d055 MW |
405 | (seq (#\-) neg) |
406 | (seq (#\!) not))) | |
407 | (token (or (seq (#\!) fact) | |
239fa5bd MW |
408 | (when nestedp |
409 | (or (seq (#\)) rp) | |
410 | (seq (#\]) rb))))))) | |
dea4d055 MW |
411 | (next (or :any (t :eof)))) |
412 | (cons value next)))))) | |
413 | ||
414 | (defun assert-expr-parse (string value winp consumedp) | |
415 | (multiple-value-bind (v w c) (test-parse-expr string) | |
416 | (flet ((message (what) | |
417 | (format nil "expression ~S; ~A" string what))) | |
418 | (cond (winp (assert-true w (message "winp")) | |
419 | (assert-equal v value (message "value"))) | |
420 | (t (assert-false w (message "winp")) | |
421 | (assert-equal v value (message "expected")))) | |
422 | (assert-eql c consumedp (message "consumedp"))))) | |
423 | ||
424 | (def-test-method test-expression-parser ((test test-parser) :run nil) | |
425 | (assert-expr-parse "1 + 2 + 3" '((+ (+ 1 2) 3) . :eof) t t) | |
426 | (assert-expr-parse "1 + 2 * 3" '((+ 1 (* 2 3)) . :eof) t t) | |
427 | (assert-expr-parse "1 * 2 + 3" '((+ (* 1 2) 3) . :eof) t t) | |
428 | (assert-expr-parse "(1 + 2) * 3" '((* (+ 1 2) 3) . :eof) t t) | |
429 | (assert-expr-parse "1 ** 2 ** 3" '((** 1 (** 2 3)) . :eof) t t) | |
430 | (assert-expr-parse "1 + 2) * 3" '((+ 1 2) . #\)) t t) | |
431 | (assert-expr-parse "1 + 2 * 3" '((+ 1 (* 2 3)) . :eof) t t) | |
dea4d055 MW |
432 | (assert-expr-parse "! 1 + 2 = 3 | 6 - 3 /= 12/6" |
433 | '((or (not (= (+ 1 2) 3)) | |
434 | (/= (- 6 3) (/ 12 6))) | |
435 | . :eof) | |
436 | t t) | |
437 | (assert-expr-parse "! 1 > 2 & ! 4 < 6 | 3 < 4 & 9 > 10" | |
438 | '((or (and (not (> 1 2)) (not (< 4 6))) | |
439 | (and (< 3 4) (> 9 10))) | |
440 | . :eof) | |
441 | t t) | |
442 | ||
443 | (assert-condition 'simple-error (test-parse-expr "(1 + 2")) | |
444 | (assert-condition 'simple-error (test-parse-expr "(1 + 2]")) | |
445 | (assert-condition 'simple-error (test-parse-expr "1 < 2 < 3"))) | |
446 | ||
447 | ;;;----- That's all, folks -------------------------------------------------- |