Coverage report: /home/ellis/comp/core/lib/parse/tests.lisp

KindCoveredAll%
expression89104 85.6
branch1922 86.4
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; lib/parse/tests.lisp --- Parser Tests
2
 
3
 ;;
4
 
5
 ;;; Code:
6
 (defpackage :parse/tests
7
   (:use :cl :rt :std :parse))
8
 
9
 (in-package :parse/tests)
10
 
11
 (defsuite :parse)
12
 (in-suite :parse)
13
 
14
 (deftest lex ()
15
   (is (string=
16
        (with-lexer-environment ("<foo>")
17
          (when (char= #\< (consume))
18
            (consume-until (make-matcher (is #\>)))))
19
        "foo"))
20
   (is (string=
21
        (let ((q "baz"))
22
          (with-lexer-environment ("foo bar baz")
23
            (consume-until (make-matcher (is q)))))
24
        "foo bar ")))
25
 
26
 (defun digitp (c) (member c '(#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\0)))
27
 
28
 (defun simple-lexer (stream)
29
   (let ((c (read-char stream nil nil)))
30
     (cond
31
       ((null c) (values nil nil))
32
       ((member c '(#\Space #\Tab #\Newline)) (simple-lexer stream))
33
       ((member c '(#\+ #\- #\* #\/ #\( #\)))
34
        (let ((v (intern (string c))))
35
          (values v v)))
36
       ((digitp c)
37
        (let ((buffer (make-array 10 :element-type 'character
38
                                     :fill-pointer 0)))
39
          (do ((c c (read-char stream nil nil)))
40
              ((or (null c) (not (digitp c)))
41
               (unless (null c) (unread-char c stream))
42
               (values 'int (read-from-string buffer)))
43
            (vector-push-extend c buffer))))
44
       ((alpha-char-p c)
45
        (let ((buffer (make-array 10 :element-type 'character
46
                                     :fill-pointer 0)))
47
          (do ((c c (read-char stream nil nil)))
48
              ((or (null c) (not (alphanumericp c)))
49
               (unless (null c) (unread-char c stream))
50
               (values 'id (copy-seq buffer)))
51
            (vector-push-extend c buffer))))
52
       (t (error "Lexing error")))))
53
 
54
 (define-parser *left-expression-parser*
55
   (:start-symbol expression)
56
   (:terminals (int id + - * / |(| |)|))
57
 
58
   (expression
59
    (expression + term)
60
    (expression - term)
61
    term)
62
 
63
   (term
64
    (term * factor)
65
    (term / factor)
66
    factor)
67
 
68
   (factor
69
    id
70
    int
71
    (|(| expression |)| (lambda (a b c) (declare (ignore a c)) b))))
72
 
73
 (define-parser *ambiguous-expression-parser*
74
   (:start-symbol expression)
75
   (:terminals (int id + - * / |(| |)|))
76
   (:muffle-conflicts (16 0))
77
 
78
   (expression
79
    (expression + expression)
80
    (expression - expression)
81
    (expression * expression)
82
    (expression / expression)
83
    id
84
    int
85
    (|(| expression |)| (lambda (a b c) (declare (ignore a c)) b))))
86
 
87
 (define-parser *precedence-left-expression-parser*
88
   (:start-symbol expression)
89
   (:terminals (int id + - * / |(| |)|))
90
   (:precedence ((:left * /) (:left + -)))
91
 
92
   (expression
93
    (expression + expression)
94
    (expression - expression)
95
    (expression * expression)
96
    (expression / expression)
97
    id
98
    int
99
    (|(| expression |)| (lambda (a b c) (declare (ignore a c)) b))))
100
 
101
 (define-parser *precedence-right-expression-parser*
102
   (:start-symbol expression)
103
   (:terminals (int id + - * / |(| |)|))
104
   (:precedence ((:right * /) (:right + -)))
105
 
106
   (expression
107
    (expression + expression)
108
    (expression - expression)
109
    (expression * expression)
110
    (expression / expression)
111
    id
112
    int
113
    (|(| expression |)| (lambda (a b c) (declare (ignore a c)) b))))
114
 
115
 (define-parser *precedence-nonassoc-expression-parser*
116
   (:start-symbol expression)
117
   (:terminals (int id + - * / |(| |)|))
118
   (:precedence ((:nonassoc * /) (:nonassoc + -)))
119
   (expression
120
    (expression + expression)
121
    (expression - expression)
122
    (expression * expression)
123
    (expression / expression)
124
    id
125
    int
126
    (|(| expression |)| (lambda (a b c) (declare (ignore a c)) b))))
127
 
128
 (deftest yacc ()
129
   (flet ((parse (parser e) 
130
            (with-input-from-string (s e)
131
              (parse-with-lexer #'(lambda () (simple-lexer s)) parser))))
132
     (let ((*package* (find-package :parse/tests)))
133
       (let ((e "(x+3)+y*z") (v '(("x" + 3) + ("y" * "z"))))
134
         (is (equal (parse *left-expression-parser* e) v))
135
         (is (equal (parse *precedence-left-expression-parser* e) v))
136
         (is (equal (parse *precedence-right-expression-parser* e) v))
137
         (is (equal (parse *precedence-nonassoc-expression-parser* e) v)))
138
       (let ((e "x+5/3*(12+y)/3+z"))
139
         (let ((v '(("x" + (((5 / 3) * (12 + "y")) / 3)) + "z")))
140
           (is (equal (parse *left-expression-parser* e) v))
141
           (is (equal (parse *precedence-left-expression-parser* e) v)))
142
         (let ((v '("x" + ((5 / (3 * ((12 + "y") / 3))) + "z"))))
143
           (is (equal (parse *precedence-right-expression-parser* e) v)))
144
         (let ((v '("x" + (5 / (3 * ((12 + "y") / (3 + "z")))))))
145
           (is (equal (parse *ambiguous-expression-parser* e) v)))
146
         (signals yacc-parse-error
147
           (parse *precedence-nonassoc-expression-parser* e)))
148
       (dolist (e '("5/3*(" "5/3)"))
149
         (signals yacc-parse-error
150
           (parse *left-expression-parser* e))
151
         (signals yacc-parse-error
152
           (parse *ambiguous-expression-parser* e))
153
         (signals yacc-parse-error
154
           (parse *precedence-left-expression-parser* e))
155
         (signals yacc-parse-error
156
           (parse *precedence-right-expression-parser* e))))))