Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 299 lines (208 sloc) 6.694 kB
3c1ccf6 first commit GIT not darcs
Nick Allen authored
1 ;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; -*-
2 ;; Sun Nov 4 17:19:54 2007 by Nick Allen <nallen05@gmail.com>
3 ;; bpm.lisp
4
5 ;note: these tests are intended to be run w/ all `bpm' vars set to their default values
6
7 ;note: these tests require ptester
8
9 ;note: these tests should work both before and after loading `bpm-prettify.lisp'
10
11 (in-package :cl-user)
12
13 (defpackage :bpm.test
14 (:use :cl :bpm :ptester))
15
16 (in-package :bpm.test)
17
18 (setf *break-on-test-failures* t)
19
20 (with-tests (:name "arrow syntax")
21
22 (test '-> ->)
23
24 (test '--> -->)
25 )
26
27 (with-tests (:name "CREATE-BPM-COMPILER variables")
28
29 (test #\_ *logic-var-prefix-char*)
30
31 (test t (funcall *logic-var-pred* '_foo))
32 (test nil (funcall *logic-var-pred* 'foo))
33
34 (test t (funcall *logic-var-wildcard-pred* '_))
35 (test nil (funcall *logic-var-wildcard-pred* '_foo))
36
37 (test t *destructure-simple-vectors-p*)
38
39 (test 'eql *logic-var-equality-test*)
40 )
41
42 (defmacro test-match (pattern thing &rest kwd-args)
43 `(test t
44 (funcall (coerce (funcall (create-bpm-compiler ',pattern)
45 t)
46 'function)
47 ',thing)
48 ,@kwd-args))
49
50 (defmacro test-no-match (pattern thing &rest kwd-args)
51 `(test nil
52 (funcall (coerce (funcall (create-bpm-compiler ',pattern)
53 t)
54 'function)
55 ',thing)
56 ,@kwd-args))
57
58 (with-tests (:name "shotgun style BPM compiler test")
59
60 (test-match t t)
61 (test-no-match t nil)
62
63 (test-match nil nil)
64 (test-no-match nil t)
65
66 (test-match 1 1)
67 (test-no-match 1 2)
68
69 (test-match (1 2 3) (1 2 3))
70 (test-no-match (1 2 3) (1 2 4))
71 (test-no-match (1 2 3) (1 2 3 4))
72
73 (test-match (1 2 . 3) (1 2 . 3))
74 (test-no-match (1 2 . 3) (1 2))
75 (test-no-match (1 2 . 3) (1 2 3))
76 (test-no-match (1 2 . 3) (1 2 . 4))
77
78 (test-match (((1)) (2) 3) (((1)) (2) 3))
79 (test-no-match (((1)) (2) 3) (((9)) (2) 3))
80 (test-no-match (((1)) (2) 3) (((1)) (9) 3))
81 (test-no-match (((1)) (2) 2) (((1)) (2) 9))
82 (test-no-match (((1 9)) (2) 2) (((1)) (2) 3))
83 (test-no-match (((1)) (2 9) 2) (((1)) (2) 3))
84 (test-no-match (((1)) (2) 2 9) (((1)) (2) 3))
85
86 (test-match _ 1)
87 (test-match _ (1 2 3 4 5))
88
89 (test-match _foo 1)
90 (test-match _foo (1 2 3 4 5))
91
92 (test-match (_1 _2) (1 2))
93
94 (test-match (_1 _2 . _3) (1 2 . 3))
95 (test-match (1 _2 . 3) (1 2 . 3))
96 (test-match (1 _2 . 3) (1 (1 2 . 3) . 3))
97 (test-no-match (1 _2 . 3) (1 2 . 9))
98 (test-no-match (1 _2 . 3) (9 2 . 3))
99
100 (test-match (_1 _1) (1 1))
101 (test-no-match (_1 _1) (1 2))
102
103 (test-match (_1 . _1) (1 . 1))
104 (test-no-match (_1 . _1) (1 . 2))
105
106 (test-match (((_1)) _1 . _1) (((1)) 1 . 1))
107 (test-no-match (((_1)) _1 . _1) (((9)) 1 . 1))
108 (test-no-match (((_1)) _1 . _1) (((1)) 9 . 1))
109 (test-no-match (((_1)) _1 . _1) (((1)) 1 . 9))
110
111 (test-match #(1 2 3) #(1 2 3))
112 (test-no-match #(1 2 3) #(1 2 9))
113
114 (test-match #(_ _ _) #(1 2 3))
115
116 (test-match #(_1 _1 _1) #(1 1 1))
117 (test-no-match #(_1 _1 _1) #(9 1 1))
118 (test-no-match #(_1 _1 _1) #(1 9 1))
119 (test-no-match #(_1 _1 _1) #(1 1 9))
120
121 (test-match (#(_1 _1 _1)) (#(1 1 1)))
122 (test-no-match (#(_1 _1 _1)) (#(9 1 1)))
123 (test-no-match (#(_1 _1 _1)) (#(1 9 1)))
124 (test-no-match (#(_1 _1 _1)) (#(1 1 9)))
125
126 (test-match (#(((_1)) (_1) _1)) (#(((1)) (1) 1)))
127 (test-no-match (#(((_1)) (_1) _1)) (#(((9)) (1) 1)))
128 (test-no-match (#(((_1)) (_1) _1)) (#(((1)) (9) 1)))
129 (test-no-match (#(((_1)) (_1) _1)) (#(((1)) (1) 9)))
130 )
131
132 (with-tests (:name "CREATE-BPM-COMPILER 2nd return value")
133
134 (test nil
135 (set-difference '(_1 _2 _3)
136 (nth-value 1 (create-bpm-compiler '(((_1)) _2 . _3)))))
137
138 (test nil
139 (set-difference (nth-value 1 (create-bpm-compiler '(((_1)) _2 . _3)))
140 '(_1 _2 _3)))
141
142 (test nil
143 (set-difference '(_1 _2 _3 _4 _5)
144 (nth-value 1 (create-bpm-compiler '(((_1)) _2 . _3)
145 '(_4 _5)))))
146
147 (test nil
148 (set-difference (nth-value 1 (create-bpm-compiler '(((_1)) _2 . _3)
149 '(_4 _5)))
150 '(_1 _2 _3 _4 _5)))
151 )
152
153 (with-tests (:name "other equality tests")
154 (let ((*logic-var-equality-test* 'string-equal))
155
156 (test-match "foo" "Foo")
157 (test-no-match "foo" "Foo1")
158
159 (test-match ("1" "2" #("3")) ("1" "2" #("3")))
160 (test-no-match ("1" "2" #("3")) ("1" "2" #("9")))
161 ))
162
163
164
165 (with-tests (:name "not destructuring simple vectors")
166 (let ((*destructure-simple-vectors-p* nil))
167
168 (test nil
169 (funcall (coerce (funcall (create-bpm-compiler #(1 2) ) t)
170 'function)
171 #(1 2)))
172 ))
173
174
175 (defmacro test-rule-match (rule val)
176 `(test t
177 (let ((fn (funcall ,rule ',val)))
178 (if fn
179 (funcall fn)))))
180
181 (defmacro test-rule-not-match (rule val)
182 `(test nil
183 (let ((fn (funcall ,rule ',val)))
184 (if fn
185 (funcall fn)))))
186
187 (with-tests (:name "BPM-LAMBDA")
188
189 (test-rule-match (bpm-lambda 1 (constantly t))
190 1)
191
192 (test-rule-not-match (bpm-lambda 1 (constantly t))
193 9)
194
195 (test-rule-match (bpm-lambda ((1)) (constantly t))
196 ((1)))
197
198 (test-rule-not-match (bpm-lambda ((1)) (constantly t))
199 ((9)))
200 )
201
202 (with-tests (:name "MATCH")
203 (test 'four (match 4
204 (4 -> 'four)
205 (5 -> 'five)))
206
207 (test 'five (match 5
208 (4 -> 'four)
209 (5 -> 'five)))
210
211 (test nil (match 6
212 (4 -> 'four)
213 (5 -> 'five)))
214
215 (test '(2 1) (match '(1 2)
216 ((_1 _2) -> (list _2 _1)))
217 :test #'equal))
218
219 (with-tests (:name "MATCH + WHERE/WHERE-NOT")
220
221 (test nil
222 (match #(a a b b)
223 (#(_1 _1 _2 _2) (where (eql _1 _2))
224 #(_1))))
225
226 (test #(a)
227 (match #(a a a a)
228 (#(_1 _1 _2 _2) (where (eql _1 _2))
229 (vector _1)))
230 :test #'equalp)
231
232 (test #(a b)
233 (match #(a a b b)
234 (#(_1 _1 _2 _2) (where-not (eql _1 _2))
235 (vector _1 _2)))
236 :test #'equalp)
237
238 (test nil
239 (match #(a a a a a)
240 (#(_1 _1 _2 _2) (where-not (eql _1 _2))
241 #(_1 _2)))))
242
243 (with-tests (:name "DEF! & DEF")
244
245 (def! speller1 1 -> 'one)
246
247 (test 'one (speller1 1))
248
249 (test nil (speller1 2))
250
251 (def speller1 2 -> 'two)
252
253 (test 'one (speller1 1))
254
255 (test 'two (speller1 2))
256
257 (test nil (speller1 3))
258
259 (def! speller2 3 -> 'three)
260
261 (test nil (speller2 1))
262
263 (test nil (speller2 2))
264
265 (test 'three (speller2 3))
266
267 (def speller2 _ -> 'other)
268
269 (test 'three (speller2 3))
270
271 (test 'other (speller2 4))
272
273 )
274
275 (with-tests (:name "DEF!/DEF + WHERE/WHERE-NOT")
276
277 (def! fn1 #(_1 _1 _2 _2)
278 (where (eql _1 _2))
279 --> (vector _1))
280
281 (def fn1 _ --> 'otherwise)
282
283 (test 'otherwise (fn1 #(a a b b)))
284 (test #(a) (fn1 #(a a a a))
285 :test #'equalp)
286
287 (def! fn2 #(_1 _1 _2 _2)
288 (where-not (eql _1 _2))
289 --> (vector _1 _2))
290
291 (def fn2 _ --> 'otherwise)
292
293 (test #(a b) (fn2 #(a a b b))
294 :test #'equalp)
295 (test 'otherwise (fn2 #(a a a a a))))
296
297 ;(defparameter x (create-bpm-compiler '(1 _1 #(_1 _2) _2)))
298
299 ;(defparameter y (funcall x '(progn (print _1) (print _2))))
Something went wrong with that request. Please try again.