1 ;;;; tests of backquote readmacro
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (in-package "CL-USER")
16 (defparameter *qq* '(*rr* *ss*))
17 (defparameter *rr* '(3 5))
18 (defparameter *ss* '(4 6))
23 (defparameter *x* '(a b))
24 (defparameter *y* '(c))
25 (defparameter *p* '(append *x* *y*))
26 (defparameter *q* '((append *x* *y*) (list 'sqrt 9)))
27 (defparameter *r* '(append *x* *y*))
28 (defparameter *s* '((append *x* *y*)))
30 (defun test-double-backquote (expression value)
31 (format t "~&Testing: ~A... " expression)
32 (assert (equal (eval (eval (read-from-string expression)))
34 (format t "Ok. Look at PPRINTed version: ")
35 (pprint (read-from-string expression)))
37 (defparameter *backquote-tests*
38 '(("``(,,*QQ*)" . (24))
40 ("``(,,@*QQ*)" . ((3 5) (4 6)))
41 ("``(FOO ,,*P*)" . (foo (a b c)))
42 ("``(FOO ,,@*Q*)" . (foo (a b c) (sqrt 9)))
43 ("``(FOO ,',*R*)" . (foo (append *x* *y*)))
44 ("``(FOO ,',@*S*)" . (foo (append *x* *y*)))
45 ("``(FOO ,@,*P*)" . (foo a b c))
46 ("``(FOO ,@',*R*)" . (foo append *x* *y*))
47 ;; The following expression produces different result under LW.
48 ("``(FOO . ,,@*Q*)" . (foo a b c sqrt 9))
49 ;; These three did not work.
50 ("``(FOO ,@',@*S*)" . (foo append *x* *y*))
51 ("``(FOO ,@,@*Q*)" . (foo a b c sqrt 9))
52 ("``(,@,@*QQ*)" . (3 5 4 6))))
55 (test-double-backquote (car test) (cdr test)))
58 (let ((string "`(foobar a b ,c ,'(e f g) d ,@'(e f g) (h i j) ,@foo)"))
59 (assert (equal (print (read-from-string string)) (read-from-string string))))
61 (let ((a '`(1 ,@a ,@b ,.c ,.d)))
62 (let ((*print-circle* t))
63 (assert (equal (read-from-string (write-to-string a)) a))))
65 (let ((s '``(,,@(list 1 2 3) 10)))
66 (assert (equal (eval (eval s)) '(1 2 3 10))))
68 (with-test (:name :comma-at-number-error)
71 (read-from-string "`(,@1)")