Add :application-type parameter for save-lisp-and-die on Windows.
[sbcl.git] / tests / backq.impure.lisp
1 ;;;; tests of backquote readmacro
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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
8 ;;;; from CMU CL.
9 ;;;;
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.
13
14 (in-package "CL-USER")
15
16 (defparameter *qq* '(*rr* *ss*))
17 (defparameter *rr* '(3 5))
18 (defparameter *ss* '(4 6))
19
20 (defun *rr* (x)
21   (reduce #'* x))
22
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*)))
29
30 (defun test-double-backquote (expression value)
31   (format t "~&Testing: ~A... " expression)
32   (assert (equal (eval (eval (read-from-string expression)))
33                  value))
34   (format t "Ok. Look at PPRINTed version: ")
35   (pprint (read-from-string expression)))
36
37 (defparameter *backquote-tests*
38   '(("``(,,*QQ*)" . (24))
39     ("``(,@,*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))))
53
54 (mapc (lambda (test)
55         (test-double-backquote (car test) (cdr test)))
56       *backquote-tests*)
57
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))))
60
61 (let ((a '`(1 ,@a ,@b ,.c ,.d)))
62   (let ((*print-circle* t))
63     (assert (equal (read-from-string (write-to-string a)) a))))
64
65 (let ((s '``(,,@(list 1 2 3) 10)))
66   (assert (equal (eval (eval s)) '(1 2 3 10))))
67
68 (with-test (:name :comma-at-number-error)
69   (assert (eq :error
70               (handler-case
71                   (read-from-string "`(,@1)")
72                 (reader-error ()
73                   :error)))))