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

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

Check in the gcl ansi test suite (original, in preparation for making local changes)

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    (setf (macro-function sym) (macro-function 'pop))
74    (eval `(let ((x '(a b c)))
75             (values
76              (,sym x)
77              x))))
78  a (b c))
79
80(deftest macro-function.11
81  (let ((fn
82         (flet ((%m () 16))
83           (macrolet ((%n (&environment env)
84                          (list 'quote (macro-function '%m env))))
85             (%n)))))
86     fn)
87  nil)
88
89(deftest macro-function.12
90  (let ((sym (gensym)))
91    (eval `(defmacro ,sym () t))
92    (let ((i 0))
93      (values
94       (funcall (macro-function (progn (incf i) sym)) (list sym) nil)
95       i)))
96  t 1)
97
98(deftest macro-function.13
99  (let ((sym (gensym)))
100    (eval `(defmacro ,sym () t))
101    (let ((i 0) a b)
102      (values
103       (funcall (macro-function (progn (setf a (incf i)) sym)
104                                (progn (setf b (incf i)) nil))
105                (list sym) nil)
106       i a b)))
107  t 2 1 2)
108
109(deftest macro-function.14
110  (let ((sym (gensym))
111        (i 0))
112    (setf (macro-function (progn (incf i) sym)) (macro-function 'pop))
113    (values
114     (eval `(let ((x '(a b c)))
115              (list
116               (,sym x)
117               x)))
118     i))
119  (a (b c)) 1)
120
121(deftest macro-function.15
122  (let ((sym (gensym))
123        (i 0) a b)
124    (setf (macro-function (progn (setf a (incf i)) sym)
125                          (progn (setf b (incf i)) nil))
126          (macro-function 'pop))
127    (values
128     (eval `(let ((x '(a b c)))
129              (list
130               (,sym x)
131               x)))
132     i a b))
133  (a (b c)) 2 1 2)
134
135
136
137;;; Error tests
138
139(deftest macro-function.error.1
140  (signals-error (macro-function) program-error)
141  t)
142
143(deftest macro-function.error.2
144  (signals-error (macro-function 'pop nil nil) program-error)
145  t)
146
Note: See TracBrowser for help on using the repository browser.