forked from Ramarren/cl-parser-combinators
-
Notifications
You must be signed in to change notification settings - Fork 1
/
test-expression.lisp
63 lines (52 loc) · 2.22 KB
/
test-expression.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
(in-package :parser-combinators-tests)
(in-suite parser-combinators-tests)
(defsuite* expression-test)
;;; parser for basic +-*/ arithmetic with subexpressions and negation
(def-cached-parser unary-minus?
(mdo (char? #\-) (result (curry #'list '-))))
(defun expr-arith? ()
(expression? (nat*)
`((,(unary-minus?) :unary)
(,(factor-op?) :left)
(,(expr-op?) :left))
(char? #\()
(char? #\))))
(defun expr-arith* ()
(expression* (nat*)
`((,(unary-minus?) :unary)
(,(factor-op?) :left)
(,(expr-op?) :left))
(char? #\()
(char? #\))))
(deftest test-expr1 ()
(is (equal '(* 1 2)
(tree-of (current-result (parse-string (expr-arith?) "1*2")))))
(is (equal '(* 1 2)
(tree-of (current-result (parse-string (expr-arith*) "1*2")))))
(is (equal '(+ 1 (* 2 3))
(tree-of (current-result (parse-string (expr-arith?) "1+2*3")))))
(is (equal '(+ 1 (* 2 3))
(tree-of (current-result (parse-string (expr-arith*) "1+2*3"))))))
(deftest test-expr2 ()
(is (equal '(+ 1 (* 2 (- 3)))
(tree-of (current-result (parse-string (expr-arith?) "1+2*-3")))))
(is (equal '(+ 1 (* 2 (- 3)))
(tree-of (current-result (parse-string (expr-arith*) "1+2*-3"))))))
(deftest test-expr3 ()
(is (equal '(* (+ 1 2) 3)
(tree-of (current-result (parse-string (expr-arith?) "(1+2)*3")))))
(is (equal '(* (+ 1 2) 3)
(tree-of (current-result (parse-string (expr-arith*) "(1+2)*3")))))
(is (equal '(* 1 (+ 2 3))
(tree-of (current-result (parse-string (expr-arith?) "1*(2+3)")))))
(is (equal '(* 1 (+ 2 3))
(tree-of (current-result (parse-string (expr-arith*) "1*(2+3)"))))))
(deftest test-random-expr-arith ()
(iter (repeat 100)
(let ((arith-string (make-random-arith-string 100)))
(is (handler-case
(= (eval (infix:string->prefix arith-string))
(eval (collapse-ops (tree-of (current-result (parse-string (expr-arith*) arith-string))))))
(division-by-zero ()
(print 'division-by-zero)
t))))))