1 ;;;; DEFGLOBAL and related tests
3 ;;;; This software is part of the SBCL system. See the README file for
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
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.
14 (proclaim '(special *foo
*))
17 (let ((*evaluator-mode
* :interpret
))
20 (defun unbound-marker ()
21 (sb-c::%primitive sb-c
:make-unbound-marker
))
22 (compile 'unbound-marker
)
24 (defun assert-foo-not-checked (fun)
25 (let* ((marker (unbound-marker))
27 (assert (eq marker
(funcall fun
)))))
29 (defun assert-foo-checked (fun)
30 (let* ((marker (unbound-marker))
36 (assert (eq '*foo
* (cell-error-name e
)))
39 (with-test (:name
:unbound-cannot-be-always-bound
)
40 (assert-error (proclaim '(sb-ext:always-bound
*foo
*))))
43 (proclaim '(sb-ext:always-bound
*foo
*))
46 (declare (optimize (safety 3)))
48 ;; When run interpreted, FOO-SAFE cannot help but check BOUNDP on *foo*
49 ;; so the assertion would fail.
52 (with-test (:name
:always-bound-elides-boundness-checking
)
53 (assert-foo-not-checked #'foo-safe
))
55 (with-test (:name
:cannot-unbind-always-bound
)
61 (defun can-globalize-p (x)
63 (progn (proclaim `(sb-ext:global
,x
)) t
)
66 (with-test (:name
:cannot-proclaim-special-global
)
67 (assert (not (can-globalize-p '*foo
*))))
69 (define-symbol-macro sm
42)
70 (with-test (:name
:cannot-proclaim-symbol-macro-global
)
71 (assert (not (can-globalize-p 'sm
))))
74 (with-test (:name
:cannot-proclaim-constant-global
)
75 (assert (not (can-globalize-p 'con
))))
77 (with-test (:name
:proclaim-global
)
78 (assert (can-globalize-p '.bar.
)))
81 (with-test (:name
:global-does-not-imply-always-bound
)
86 (cell-error-name e
))))))
88 (with-test (:name
:set-global
)
92 (assert (= 123 (bar1))))
94 (with-test (:name
:cannot-bind-globals
)
95 (assert-error (eval* '(let ((.bar.
6)) .bar.
)))
96 (multiple-value-bind (fun failure-p
)
97 (checked-compile `(lambda ()
98 (let ((.bar.
5)) .bar.
))
101 (assert-error (funcall fun
))))
103 (with-test (:name
:cannot-define-globals-as-symmacs
)
104 (assert-error (eval* '(define-symbol-macro .bar.
0)))
105 (assert-error (eval* `(symbol-macrolet ((.bar.
11)) .bar.
)))
106 (multiple-value-bind (fun failure-p
)
107 (checked-compile `(lambda ()
108 (symbol-macrolet ((.bar.
11)) .bar.
))
111 (assert-error (funcall fun
))))
113 ;;; Cannot proclaim or declare a global as special
114 (with-test (:name
:cannot-declare-global-special
)
115 (assert-error (proclaim '(special .bar.
666)))
116 (assert-error (eval `(locally (declare (special .bar.
)) .bar.
)))
117 (multiple-value-bind (fun failure-p
)
118 (checked-compile `(lambda ()
119 (declare (special .bar.
))
123 (assert-error (funcall fun
))))
125 ;;; Dead globals get bound checks
126 (declaim (global this-is-unbound
))
127 (with-test (:name
:dead-unbound-global
)
128 (let ((fun (checked-compile '(lambda ()
131 (assert-error (funcall fun
) unbound-variable
)))
133 (defun compile-form (form)
134 (let* ((lisp "defglobal-impure-tmp.lisp"))
137 (with-open-file (f lisp
:direction
:output
)
139 (multiple-value-bind (fasl warn fail
) (compile-file lisp
)
140 (declare (ignore warn
))
142 (error "compiling ~S failed" form
))
144 (ignore-errors (delete-file lisp
)))))
147 (with-test (:name
:defconstant-evals
)
149 (fasl (compile-form `(defglobal .counter-1.
(incf *counter
*)))))
150 (assert (= 1 *counter
*))
151 (assert (= 1 (symbol-value '.counter-1.
)))
152 (assert (eq :global
(sb-int:info
:variable
:kind
'.counter-1.
)))
155 (ignore-errors (delete-file fasl
)))
156 (assert (= 1 *counter
*))
157 (assert (= 1 (symbol-value '.counter-1.
))))
159 (set '.counter-2.
:bound
)
161 (fasl (compile-form `(defglobal .counter-2.
(incf *counter
*)))))
162 (assert (= 0 *counter
*))
163 (assert (eq :bound
(symbol-value '.counter-2.
)))
164 (assert (eq :global
(sb-int:info
:variable
:kind
'.counter-2.
)))
167 (ignore-errors (delete-file fasl
)))
168 (assert (= 0 *counter
*))
169 (assert (eq :bound
(symbol-value '.counter-2.
))))
171 ;; This is a *really* dirty trick...
173 (fasl (let ((.counter-3.
:nasty
))
174 (declare (special .counter-3.
))
175 (compile-form `(defglobal .counter-3.
(incf *counter
*))))))
176 (assert (= 0 *counter
*))
177 (assert (not (boundp '.counter-3.
)))
178 (assert (eq :global
(sb-int:info
:variable
:kind
'.counter-3.
)))
181 (ignore-errors (delete-file fasl
)))
182 (assert (= 1 *counter
*))
183 (assert (= 1 (symbol-value '.counter-3.
)))))
185 (with-test (:name
:defglobal-refers-to-defglobal
)
186 (let ((fasl (compile-form `(progn
187 (defglobal **global-1
** :fii
)
188 (defglobal **global-2
** **global-1
**)))))
190 (assert (eq (symbol-value '**global-1
**) (symbol-value '**global-2
**)))
191 (assert (eq :fii
(symbol-value '**global-1
**)))))