Commit | Line | Data |
---|---|---|
04bb321a | 1 | ;;;; elisp.test --- tests guile's elisp support -*- scheme -*- |
c58b8c5a | 2 | ;;;; Copyright (C) 2002, 2003, 2006, 2009 Free Software Foundation, Inc. |
04bb321a | 3 | ;;;; |
73be1d9e MV |
4 | ;;;; This library is free software; you can redistribute it and/or |
5 | ;;;; modify it under the terms of the GNU Lesser General Public | |
6 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 7 | ;;;; version 3 of the License, or (at your option) any later version. |
73be1d9e MV |
8 | ;;;; |
9 | ;;;; This library is distributed in the hope that it will be useful, | |
04bb321a | 10 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
11 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | ;;;; Lesser General Public License for more details. | |
13 | ;;;; | |
14 | ;;;; You should have received a copy of the GNU Lesser General Public | |
15 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 16 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
04bb321a | 17 | |
e68ef9c8 DH |
18 | (define-module (test-suite test-elisp) |
19 | :use-module (test-suite lib) | |
20 | :use-module (ice-9 weak-vector)) | |
21 | ||
c58b8c5a AW |
22 | ;; FIXME: the test suite is good, but it uses the old lang elisp module |
23 | ;; instead of the new code. Disable for now. | |
24 | '( | |
25 | ||
62f80361 AW |
26 | (define *old-stack-level* (and=> (memq 'stack (debug-options)) cadr)) |
27 | (if *old-stack-level* | |
28 | (debug-set! stack (* 2 *old-stack-level*))) | |
29 | ||
c2521a21 AW |
30 | (define *old-%load-should-autocompile* %load-should-autocompile) |
31 | (set! %load-should-autocompile #f) | |
32 | ||
04bb321a NJ |
33 | ;;; |
34 | ;;; elisp | |
35 | ;;; | |
36 | ||
37 | (if (defined? '%nil) | |
38 | ||
39 | (with-test-prefix "scheme" | |
40 | ||
41 | (with-test-prefix "nil value is a boolean" | |
42 | ||
43 | (pass-if "boolean?" | |
44 | (boolean? %nil)) | |
45 | ||
46 | ) | |
47 | ||
48 | (with-test-prefix "nil value is false" | |
49 | ||
50 | (pass-if "not" | |
51 | (eq? (not %nil) #t)) | |
52 | ||
53 | (pass-if "if" | |
54 | (if %nil #f #t)) | |
55 | ||
56 | (pass-if "and" | |
57 | (eq? (and %nil #t) #f)) | |
58 | ||
59 | (pass-if "or" | |
60 | (eq? (or %nil #f) #f)) | |
61 | ||
62 | (pass-if "cond" | |
63 | (cond (%nil #f) (else #t))) | |
64 | ||
65 | (pass-if "do" | |
66 | (call-with-current-continuation | |
67 | (lambda (exit) | |
68 | (do ((i 0 (+ i 1))) | |
69 | (%nil (exit #f)) | |
70 | (if (> i 10) | |
71 | (exit #t)))))) | |
72 | ||
73 | ) | |
74 | ||
75 | (with-test-prefix "nil value as an empty list" | |
76 | ||
77 | (pass-if "list?" | |
78 | (list? %nil)) | |
79 | ||
80 | (pass-if "null?" | |
81 | (null? %nil)) | |
82 | ||
83 | (pass-if "sort" | |
84 | (eq? (sort %nil <) %nil)) | |
85 | ||
86 | ) | |
87 | ||
88 | (with-test-prefix "lists formed using nil value" | |
89 | ||
90 | (pass-if "list?" | |
91 | (list? (cons 'a %nil))) | |
92 | ||
962b1f0b NJ |
93 | (pass-if "length of %nil" |
94 | (= (length %nil) 0)) | |
95 | ||
04bb321a NJ |
96 | (pass-if "length" |
97 | (= (length (cons 'a (cons 'b (cons 'c %nil)))) 3)) | |
98 | ||
99 | (pass-if "length (with backquoted list)" | |
100 | (= (length `(a b c . ,%nil)) 3)) | |
101 | ||
bbd26b5a NJ |
102 | (pass-if "write (%nil)" |
103 | (string=? (with-output-to-string | |
104 | (lambda () (write %nil))) | |
105 | "#nil")) ; Hmmm... should be "()" ? | |
106 | ||
107 | (pass-if "display (%nil)" | |
108 | (string=? (with-output-to-string | |
109 | (lambda () (display %nil))) | |
110 | "#nil")) ; Ditto. | |
111 | ||
112 | (pass-if "write (list)" | |
04bb321a NJ |
113 | (string=? (with-output-to-string |
114 | (lambda () (write (cons 'a %nil)))) | |
115 | "(a)")) | |
116 | ||
bbd26b5a | 117 | (pass-if "display (list)" |
04bb321a NJ |
118 | (string=? (with-output-to-string |
119 | (lambda () (display (cons 'a %nil)))) | |
120 | "(a)")) | |
121 | ||
962b1f0b NJ |
122 | (pass-if "assq" |
123 | (and (equal? (assq 1 `((1 one) (2 two) . ,%nil)) | |
124 | '(1 one)) | |
125 | (equal? (assq 3 `((1 one) (2 two) . ,%nil)) | |
126 | #f))) | |
127 | ||
128 | (pass-if "assv" | |
129 | (and (equal? (assv 1 `((1 one) (2 two) . ,%nil)) | |
130 | '(1 one)) | |
131 | (equal? (assv 3 `((1 one) (2 two) . ,%nil)) | |
132 | #f))) | |
133 | ||
134 | (pass-if "assoc" | |
135 | (and (equal? (assoc 1 `((1 one) (2 two) . ,%nil)) | |
136 | '(1 one)) | |
137 | (equal? (assoc 3 `((1 one) (2 two) . ,%nil)) | |
138 | #f))) | |
139 | ||
140 | (pass-if "with-fluids*" | |
141 | (let ((f (make-fluid)) | |
142 | (g (make-fluid))) | |
143 | (with-fluids* (cons f (cons g %nil)) | |
144 | '(3 4) | |
145 | (lambda () | |
146 | (and (eq? (fluid-ref f) 3) | |
147 | (eq? (fluid-ref g) 4)))))) | |
148 | ||
149 | (pass-if "append!" | |
150 | (let ((a (copy-tree '(1 2 3))) | |
151 | (b (copy-tree `(4 5 6 . ,%nil))) | |
152 | (c (copy-tree '(7 8 9))) | |
153 | (d (copy-tree `(a b c . ,%nil)))) | |
154 | (equal? (append! a b c d) | |
155 | `(1 2 3 4 5 6 7 8 9 a b c . ,%nil)))) | |
156 | ||
157 | (pass-if "last-pair" | |
158 | (equal? (last-pair `(1 2 3 4 5 . ,%nil)) | |
159 | (cons 5 %nil))) | |
160 | ||
161 | (pass-if "reverse" | |
162 | (equal? (reverse `(1 2 3 4 5 . ,%nil)) | |
163 | '(5 4 3 2 1))) ; Hmmm... is this OK, or | |
164 | ; should it be | |
165 | ; `(5 4 3 2 1 . ,%nil) ? | |
166 | ||
167 | (pass-if "reverse!" | |
168 | (equal? (reverse! (copy-tree `(1 2 3 4 5 . ,%nil))) | |
169 | '(5 4 3 2 1))) ; Ditto. | |
170 | ||
171 | (pass-if "list-ref" | |
172 | (eq? (list-ref `(0 1 2 3 4 . ,%nil) 4) 4)) | |
173 | ||
174 | (pass-if-exception "list-ref" | |
175 | exception:out-of-range | |
176 | (eq? (list-ref `(0 1 2 3 4 . ,%nil) 6) 6)) | |
177 | ||
178 | (pass-if "list-set!" | |
179 | (let ((l (copy-tree `(0 1 2 3 4 . ,%nil)))) | |
180 | (list-set! l 4 44) | |
181 | (= (list-ref l 4) 44))) | |
182 | ||
183 | (pass-if-exception "list-set!" | |
184 | exception:out-of-range | |
185 | (let ((l (copy-tree `(0 1 2 3 4 . ,%nil)))) | |
186 | (list-set! l 6 44) | |
187 | (= (list-ref l 6) 44))) | |
188 | ||
bbd26b5a NJ |
189 | (pass-if "list-cdr-set!" |
190 | (let ((l (copy-tree `(0 1 2 3 4 . ,%nil)))) | |
191 | (and (begin | |
192 | (list-cdr-set! l 4 44) | |
193 | (equal? l '(0 1 2 3 4 . 44))) | |
194 | (begin | |
195 | (list-cdr-set! l 3 `(new . ,%nil)) | |
196 | (equal? l `(0 1 2 3 new . ,%nil)))))) | |
197 | ||
198 | (pass-if-exception "list-cdr-set!" | |
199 | exception:out-of-range | |
200 | (let ((l (copy-tree `(0 1 2 3 4 . ,%nil)))) | |
201 | (list-cdr-set! l 6 44))) | |
202 | ||
203 | (pass-if "memq" | |
204 | (equal? (memq 'c `(a b c d . ,%nil)) `(c d . ,%nil))) | |
205 | ||
206 | (pass-if "memv" | |
207 | (equal? (memv 'c `(a b c d . ,%nil)) `(c d . ,%nil))) | |
208 | ||
209 | (pass-if "member" | |
210 | (equal? (member "c" `("a" "b" "c" "d" . ,%nil)) `("c" "d" . ,%nil))) | |
211 | ||
212 | (pass-if "list->vector" | |
42ad901d | 213 | (equal? '#(1 2 3) (list->vector `(1 2 3 . ,%nil)))) |
bbd26b5a NJ |
214 | |
215 | (pass-if "list->vector" | |
42ad901d | 216 | (equal? '#(1 2 3) (list->vector `(1 2 3 . ,%nil)))) |
bbd26b5a NJ |
217 | |
218 | (pass-if "list->weak-vector" | |
219 | (equal? (weak-vector 1 2 3) (list->weak-vector `(1 2 3 . ,%nil)))) | |
220 | ||
221 | (pass-if "sorted?" | |
222 | (and (sorted? `(1 2 3 . ,%nil) <) | |
223 | (not (sorted? `(1 6 3 . ,%nil) <)))) | |
224 | ||
225 | (pass-if "merge" | |
226 | (equal? (merge '(1 4 7 10) | |
227 | (merge `(2 5 8 11 . ,%nil) | |
228 | `(3 6 9 12 . ,%nil) | |
229 | <) | |
230 | <) | |
231 | `(1 2 3 4 5 6 7 8 9 10 11 12 . ,%nil))) | |
232 | ||
233 | (pass-if "merge!" | |
234 | (equal? (merge! (copy-tree '(1 4 7 10)) | |
235 | (merge! (copy-tree `(2 5 8 11 . ,%nil)) | |
236 | (copy-tree `(3 6 9 12 . ,%nil)) | |
237 | <) | |
238 | <) | |
239 | `(1 2 3 4 5 6 7 8 9 10 11 12 . ,%nil))) | |
240 | ||
241 | (pass-if "sort" | |
242 | (equal? (sort `(1 5 3 8 4 . ,%nil) <) '(1 3 4 5 8))) | |
243 | ||
244 | (pass-if "stable-sort" | |
245 | (equal? (stable-sort `(1 5 3 8 4 . ,%nil) <) '(1 3 4 5 8))) | |
246 | ||
247 | (pass-if "sort!" | |
248 | (equal? (sort! (copy-tree `(1 5 3 8 4 . ,%nil)) <) | |
249 | '(1 3 4 5 8))) | |
250 | ||
251 | (pass-if "stable-sort!" | |
252 | (equal? (stable-sort! (copy-tree `(1 5 3 8 4 . ,%nil)) <) | |
253 | '(1 3 4 5 8))) | |
254 | ||
04bb321a NJ |
255 | ) |
256 | ||
257 | (with-test-prefix "value preservation" | |
258 | ||
259 | (pass-if "car" | |
260 | (eq? (car (cons %nil 'a)) %nil)) | |
261 | ||
262 | (pass-if "cdr" | |
263 | (eq? (cdr (cons 'a %nil)) %nil)) | |
264 | ||
265 | (pass-if "vector-ref" | |
266 | (eq? (vector-ref (vector %nil) 0) %nil)) | |
267 | ||
268 | ) | |
269 | ||
270 | )) | |
271 | ||
a64e6669 NJ |
272 | (if (defined? '%nil) |
273 | (use-modules (lang elisp interface))) | |
274 | ||
275 | (if (defined? '%nil) | |
276 | ||
277 | (with-test-prefix "elisp" | |
278 | ||
279 | (define (elisp-pass-if expr expected) | |
280 | (pass-if (with-output-to-string | |
281 | (lambda () | |
282 | (write expr))) | |
283 | (let ((calc (with-output-to-string | |
284 | (lambda () | |
285 | (write (eval-elisp expr)))))) | |
286 | (string=? calc expected)))) | |
287 | ||
ec5cb825 AW |
288 | (define (elisp-pass-if/maybe-error key expr expected) |
289 | (pass-if (with-output-to-string (lambda () (write expr))) | |
290 | (string=? | |
291 | (catch key | |
292 | (lambda () | |
293 | (with-output-to-string | |
294 | (lambda () (write (eval-elisp expr))))) | |
295 | (lambda (k . args) | |
296 | (format (current-error-port) | |
297 | "warning: caught ~a: ~a\n" k args) | |
298 | (throw 'unresolved))) | |
299 | expected))) | |
300 | ||
a64e6669 NJ |
301 | (elisp-pass-if '(and #f) "#f") |
302 | (elisp-pass-if '(and #t) "#t") | |
303 | (elisp-pass-if '(and nil) "#nil") | |
304 | (elisp-pass-if '(and t) "#t") | |
305 | (elisp-pass-if '(and) "#t") | |
306 | (elisp-pass-if '(cond (nil t) (t 3)) "3") | |
307 | (elisp-pass-if '(cond (nil t) (t)) "#t") | |
308 | (elisp-pass-if '(cond (nil)) "#nil") | |
309 | (elisp-pass-if '(cond) "#nil") | |
310 | (elisp-pass-if '(if #f 'a 'b) "b") | |
311 | (elisp-pass-if '(if #t 'a 'b) "a") | |
312 | (elisp-pass-if '(if '() 'a 'b) "b") | |
313 | (elisp-pass-if '(if nil 'a 'b) "b") | |
314 | (elisp-pass-if '(if nil 1 2 3 4) "4") | |
315 | (elisp-pass-if '(if nil 1 2) "2") | |
316 | (elisp-pass-if '(if nil 1) "#nil") | |
317 | (elisp-pass-if '(if t 1 2) "1") | |
318 | (elisp-pass-if '(if t 1) "1") | |
319 | (elisp-pass-if '(let (a) a) "#nil") | |
320 | (elisp-pass-if '(let* (a) a) "#nil") | |
321 | (elisp-pass-if '(let* ((a 1) (b (* a 2))) b) "2") | |
322 | (elisp-pass-if '(memq '() '(())) "(())") | |
323 | (elisp-pass-if '(memq '() '(nil)) "(#nil)") | |
324 | (elisp-pass-if '(memq '() '(t)) "#nil") | |
325 | (elisp-pass-if '(memq nil '(())) "(())") | |
326 | (elisp-pass-if '(memq nil '(nil)) "(#nil)") | |
327 | (elisp-pass-if '(memq nil (list nil)) "(#nil)") | |
328 | (elisp-pass-if '(null '#f) "#t") | |
329 | (elisp-pass-if '(null '()) "#t") | |
330 | (elisp-pass-if '(null 'nil) "#t") | |
331 | (elisp-pass-if '(null nil) "#t") | |
332 | (elisp-pass-if '(or 1 2 3) "1") | |
333 | (elisp-pass-if '(or nil t nil) "#t") | |
334 | (elisp-pass-if '(or nil) "#nil") | |
335 | (elisp-pass-if '(or t nil t) "#t") | |
336 | (elisp-pass-if '(or t) "#t") | |
337 | (elisp-pass-if '(or) "#nil") | |
338 | (elisp-pass-if '(prog1 1 2 3) "1") | |
339 | (elisp-pass-if '(prog2 1 2 3) "2") | |
340 | (elisp-pass-if '(progn 1 2 3) "3") | |
341 | (elisp-pass-if '(while nil 1) "#nil") | |
342 | ||
343 | (elisp-pass-if '(defun testf (x y &optional o &rest r) (list x y o r)) "testf") | |
344 | (elisp-pass-if '(testf 1 2) "(1 2 #nil #nil)") | |
345 | (elisp-pass-if '(testf 1 2 3 4 5 56) "(1 2 3 (4 5 56))") | |
346 | ;; NB `lambda' in Emacs is self-quoting, but that's only after | |
347 | ;; loading the macro definition of lambda in subr.el. | |
348 | (elisp-pass-if '(function (lambda (x y &optional o &rest r) (list x y o r))) "(lambda (x y &optional o &rest r) (list x y o r))") | |
349 | (elisp-pass-if '(funcall (lambda (x y &optional o &rest r) (list x y o r)) 1 2 3 4) "(1 2 3 (4))") | |
a64e6669 | 350 | |
fb10a008 AW |
351 | (elisp-pass-if '(apply (lambda (x y &optional o &rest r) (list x y o r)) 1 2 3 nil) |
352 | "(1 2 3 #nil)") | |
ec5cb825 | 353 | |
a64e6669 NJ |
354 | (elisp-pass-if '(setq x 3) "3") |
355 | (elisp-pass-if '(defvar x 4) "x") | |
356 | (elisp-pass-if 'x "3") | |
357 | ||
358 | )) | |
359 | ||
c2521a21 | 360 | (set! %load-should-autocompile *old-%load-should-autocompile*) |
62f80361 AW |
361 | (debug-set! stack *old-stack-level*) |
362 | ||
c58b8c5a | 363 | ) |
04bb321a | 364 | ;;; elisp.test ends here |