1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; The software is in the public domain and is provided with
5 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
8 (defpackage :sb-cltl2-tests
9 (:use :sb-cltl2 :cl :sb-rt))
11 (in-package :sb-cltl2-tests)
15 (defmacro *x*-value ()
16 (declare (special *x*))
19 (deftest compiler-let.1
21 (compiler-let ((*x* :inner))
22 (list *x* (*x*-value))))
25 (defvar *expansions* nil)
26 (defmacro macroexpand-macro (arg)
27 (push arg *expansions*)
30 (deftest macroexpand-all.1
32 (macroexpand-all '(defmethod foo ((x fixnum)) (1+ x)))
36 (deftest macroexpand-all.2
37 (let ((*expansions* nil))
38 (macroexpand-all '(list (macroexpand-macro 1)
39 (let (macroexpand-macro :no)
40 (macroexpand-macro 2))))
41 (remove-duplicates (sort *expansions* #'<)))
44 (deftest macroexpand-all.3
45 (let ((*expansions* nil))
46 (compile nil '(lambda ()
47 (macrolet ((foo (key &environment env)
48 (macroexpand-all `(bar ,key) env)))
51 (push key *expansions*)
54 (remove-duplicates *expansions*))
58 (multiple-value-bind (expansion macro-p)
59 (macroexpand 'srlt env)
60 (when macro-p (eval expansion))))
61 (defmacro testr (&environment env)
62 `',(getf (smv env) nil))
64 (deftest macroexpand-all.4
65 (macroexpand-all '(symbol-macrolet ((srlt '(nil zool))) (testr)))
66 (symbol-macrolet ((srlt '(nil zool))) 'zool))
68 (defmacro dinfo (thing &environment env)
69 `',(declaration-information thing env))
72 `(macrolet ((frob (suffix answer &optional declaration)
73 `(deftest ,(intern (concatenate 'string
74 "DECLARATION-INFORMATION."
77 (locally (declare ,@(when declaration
79 (cadr (assoc ',',x (dinfo optimize))))
82 (frob ".0" 0 (optimize (,x 0)))
83 (frob ".1" 1 (optimize (,x 1)))
84 (frob ".2" 2 (optimize (,x 2)))
85 (frob ".3" 3 (optimize (,x 3)))
86 (frob ".IMPLICIT" 3 (optimize ,x)))))
90 (def compilation-speed)
93 (deftest declaration-information.muffle-conditions.default
94 (dinfo sb-ext:muffle-conditions)
96 (deftest declaration-information.muffle-conditions.1
97 (locally (declare (sb-ext:muffle-conditions warning))
98 (dinfo sb-ext:muffle-conditions))
100 (deftest declaration-information.muffle-conditions.2
101 (locally (declare (sb-ext:muffle-conditions warning))
102 (locally (declare (sb-ext:unmuffle-conditions style-warning))
103 (let ((dinfo (dinfo sb-ext:muffle-conditions)))
106 (and (subtypep dinfo '(and warning (not style-warning)))
107 (subtypep '(and warning (not style-warning)) dinfo)))))))
110 ;;;; VARIABLE-INFORMATION
114 (defmacro var-info (var &environment env)
115 (list 'quote (multiple-value-list (variable-information var env))))
117 (deftest variable-info.global-special/unbound
121 (deftest variable-info.global-special/unbound/extra-decl
122 (locally (declare (special *foo*))
126 (deftest variable-info.global-special/bound
131 (deftest variable-info.global-special/bound/extra-decl
133 (declare (special *foo*))
137 (deftest variable-info.local-special/unbound
138 (locally (declare (special x))
142 (deftest variable-info.local-special/bound
144 (declare (special x))
148 (deftest variable-info.local-special/shadowed
150 (declare (special x))
157 (deftest variable-info.local-special/shadows-lexical
160 (declare (special x))
164 (deftest variable-info.lexical
169 (deftest variable-info.ignore
173 (:lexical t ((ignore . t))))
175 (deftest variable-info.symbol-macro/local
176 (symbol-macrolet ((x 8))
178 (:symbol-macro t nil))
180 (define-symbol-macro my-symbol-macro t)
182 (deftest variable-info.symbol-macro/global
183 (var-info my-symbol-macro)
184 (:symbol-macro nil nil))
186 (deftest variable-info.undefined
187 (var-info #:undefined)
190 ;;;; FUNCTION-INFORMATION
192 (defmacro fun-info (var &environment env)
193 (list 'quote (multiple-value-list (function-information var env))))
195 (defun my-global-fun (x) x)
197 (deftest function-info.global/no-ftype
198 (fun-info my-global-fun)
201 (declaim (ftype (function (cons) (values t &optional)) my-global-fun-2))
203 (defun my-global-fun-2 (x) x)
205 (deftest function-info.global/ftype
206 (fun-info my-global-fun-2)
207 (:function nil ((ftype function (cons) (values t &optional)))))
209 (defmacro my-macro (x) x)
211 (deftest function-info.macro
215 (deftest function-info.macrolet
216 (macrolet ((thingy () nil))
220 (deftest function-info.special-form
222 (:special-form nil nil))
224 (deftest function-info.notinline/local
226 (declare (notinline x))
229 (:function t ((inline . notinline))))
231 (declaim (notinline my-notinline))
232 (defun my-notinline (x) x)
234 (deftest function-info.notinline/global
235 (fun-info my-notinline)
236 (:function nil ((inline . notinline))))
238 (declaim (inline my-inline))
239 (defun my-inline (x) x)
241 (deftest function-info.inline/global
243 (:function nil ((inline . inline))))
245 (deftest function-information.known-inline
246 (locally (declare (inline identity))
248 (:function nil ((inline . inline)
249 (ftype function (t) (values t &optional)))))