1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Fri Jun 3 22:17:34 2005 |
---|
4 | ;;;; Contains: Tests of MACRO-FUNCTION |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | (deftest macro-function.1 |
---|
9 | (loop for n in *cl-macro-symbols* |
---|
10 | unless (macro-function n) |
---|
11 | collect n) |
---|
12 | nil) |
---|
13 | |
---|
14 | (deftest macro-function.2 |
---|
15 | (loop for n in *cl-macro-symbols* |
---|
16 | unless (macro-function n nil) |
---|
17 | collect n) |
---|
18 | nil) |
---|
19 | |
---|
20 | (deftest macro-function.3 |
---|
21 | (loop for n in *cl-macro-symbols* |
---|
22 | unless (eval `(macrolet ((%m (s &environment env) |
---|
23 | (list 'quote |
---|
24 | (macro-function s env)))) |
---|
25 | (%m ,n))) |
---|
26 | collect n) |
---|
27 | nil) |
---|
28 | |
---|
29 | (deftest macro-function.4 |
---|
30 | (macro-function (gensym)) |
---|
31 | nil) |
---|
32 | |
---|
33 | (deftest macro-function.5 |
---|
34 | (remove-if-not #'macro-function *cl-function-symbols*) |
---|
35 | nil) |
---|
36 | |
---|
37 | (deftest macro-function.6 |
---|
38 | (remove-if-not #'macro-function *cl-accessor-symbols*) |
---|
39 | nil) |
---|
40 | |
---|
41 | (deftest macro-function.7 |
---|
42 | (let ((fn |
---|
43 | (macrolet ((%m () 16)) |
---|
44 | (macrolet ((%n (&environment env) |
---|
45 | (list 'quote (macro-function '%m env)))) |
---|
46 | (%n))))) |
---|
47 | (values |
---|
48 | (notnot (functionp fn)) |
---|
49 | (funcall fn '(%m) nil))) |
---|
50 | t 16) |
---|
51 | |
---|
52 | (deftest macro-function.8 |
---|
53 | (let ((sym (gensym))) |
---|
54 | (setf (macro-function sym) (macro-function 'pop)) |
---|
55 | (eval `(let ((x '(a b c))) |
---|
56 | (values |
---|
57 | (,sym x) |
---|
58 | x)))) |
---|
59 | a (b c)) |
---|
60 | |
---|
61 | (deftest macro-function.9 |
---|
62 | (let ((sym (gensym))) |
---|
63 | (setf (macro-function sym nil) (macro-function 'pop)) |
---|
64 | (eval `(let ((x '(a b c))) |
---|
65 | (values |
---|
66 | (,sym x) |
---|
67 | x)))) |
---|
68 | a (b c)) |
---|
69 | |
---|
70 | (deftest macro-function.10 |
---|
71 | (let ((sym (gensym))) |
---|
72 | (eval `(defun ,sym (x) :bad)) |
---|
73 | (handler-bind ((warning #'muffle-warning)) |
---|
74 | (setf (macro-function sym) (macro-function 'pop))) |
---|
75 | (eval `(let ((x '(a b c))) |
---|
76 | (values |
---|
77 | (,sym x) |
---|
78 | x)))) |
---|
79 | a (b c)) |
---|
80 | |
---|
81 | (deftest macro-function.11 |
---|
82 | (let ((fn |
---|
83 | (flet ((%m () 16)) |
---|
84 | (macrolet ((%n (&environment env) |
---|
85 | (list 'quote (macro-function '%m env)))) |
---|
86 | (%n))))) |
---|
87 | fn) |
---|
88 | nil) |
---|
89 | |
---|
90 | (deftest macro-function.12 |
---|
91 | (let ((sym (gensym))) |
---|
92 | (eval `(defmacro ,sym () t)) |
---|
93 | (let ((i 0)) |
---|
94 | (values |
---|
95 | (funcall (macro-function (progn (incf i) sym)) (list sym) nil) |
---|
96 | i))) |
---|
97 | t 1) |
---|
98 | |
---|
99 | (deftest macro-function.13 |
---|
100 | (let ((sym (gensym))) |
---|
101 | (eval `(defmacro ,sym () t)) |
---|
102 | (let ((i 0) a b) |
---|
103 | (values |
---|
104 | (funcall (macro-function (progn (setf a (incf i)) sym) |
---|
105 | (progn (setf b (incf i)) nil)) |
---|
106 | (list sym) nil) |
---|
107 | i a b))) |
---|
108 | t 2 1 2) |
---|
109 | |
---|
110 | (deftest macro-function.14 |
---|
111 | (let ((sym (gensym)) |
---|
112 | (i 0)) |
---|
113 | (setf (macro-function (progn (incf i) sym)) (macro-function 'pop)) |
---|
114 | (values |
---|
115 | (eval `(let ((x '(a b c))) |
---|
116 | (list |
---|
117 | (,sym x) |
---|
118 | x))) |
---|
119 | i)) |
---|
120 | (a (b c)) 1) |
---|
121 | |
---|
122 | (deftest macro-function.15 |
---|
123 | (let ((sym (gensym)) |
---|
124 | (i 0) a b) |
---|
125 | (setf (macro-function (progn (setf a (incf i)) sym) |
---|
126 | (progn (setf b (incf i)) nil)) |
---|
127 | (macro-function 'pop)) |
---|
128 | (values |
---|
129 | (eval `(let ((x '(a b c))) |
---|
130 | (list |
---|
131 | (,sym x) |
---|
132 | x))) |
---|
133 | i a b)) |
---|
134 | (a (b c)) 2 1 2) |
---|
135 | |
---|
136 | |
---|
137 | |
---|
138 | ;;; Error tests |
---|
139 | |
---|
140 | (deftest macro-function.error.1 |
---|
141 | (signals-error (macro-function) program-error) |
---|
142 | t) |
---|
143 | |
---|
144 | (deftest macro-function.error.2 |
---|
145 | (signals-error (macro-function 'pop nil nil) program-error) |
---|
146 | t) |
---|
147 | |
---|