source: trunk/tests/ansi-tests/macro-function.lsp @ 9050

Last change on this file since 9050 was 9050, checked in by gz, 11 years ago

Muffle a couple more cases of random output

File size: 3.0 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.