Use defglobal more
[sbcl.git] / tests / deprecation.internal.impure.lisp
blob6399ddcc0ba443aaf344ab8aeb1d19ffc3581d78
1 ;;;; This software is part of the SBCL system. See the README file for
2 ;;;; more information.
3 ;;;;
4 ;;;; While most of SBCL is derived from the CMU CL system, the test
5 ;;;; files (like this one) were written from scratch after the fork
6 ;;;; from CMU CL.
7 ;;;;
8 ;;;; This software is in the public domain and is provided with
9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
10 ;;;; more information.
12 (load "assertoid.lisp")
13 (use-package '#:assertoid)
15 ;;;; Helpers
17 (defun test (kind name state make-body
18 &key (replacements
19 (list (format nil "~A.~A"
20 name '#:replacement))))
21 (flet ((search-string (string)
22 (declare (ignorable string))
23 (let ((start))
24 (dolist (fragment `(,(string name)
25 "deprecated" "as" "of" "SBCL" "1.2.10"
26 "Use" ,@replacements "instead"))
27 (let ((match (search fragment string :start2 (or start 0))))
28 (assert match)
29 (setf start (+ match (length fragment))))))))
30 ;; Check the signaled warning condition.
31 (let* ((condition)
32 (count 0)
33 (function (handler-bind
34 ((warning (lambda (c)
35 (incf count)
36 (setf condition c)
37 (muffle-warning))))
38 (compile nil `(lambda ()
39 ,@(funcall make-body name))))))
40 (assert (= count 1))
41 (assert (typep condition (ecase state
42 (:early 'early-deprecation-warning)
43 (:late 'late-deprecation-warning)
44 (:final 'final-deprecation-warning))))
45 (search-string (princ-to-string condition))
46 (ecase state
47 ((:early :late)
48 (assert (eq :deprecated (funcall function))))
49 (:final
50 (assert-error (funcall function)
51 (or deprecation-error cell-error)))))
52 ;; Check the documentation.
53 #+sb-doc
54 (search-string (documentation name kind))))
56 ;;;; Deprecated variables
58 (sb-int:define-deprecated-variable :early "1.2.10"
59 deprecated-variable.early
60 :value :deprecated
61 :replacement deprecated-variable.early.replacement)
63 (with-test (:name (sb-int:define-deprecated-variable :early))
64 (test 'variable 'deprecated-variable.early :early
65 (lambda (name) `(,name)))
66 (test 'variable 'deprecated-variable.early :early
67 (lambda (name) `((symbol-value ',name))))
68 (test 'variable 'deprecated-variable.early :early
69 (lambda (name) `((symbol-global-value ',name)))))
71 (sb-int:define-deprecated-variable :late "1.2.10"
72 deprecated-variable.late
73 :value :deprecated
74 :replacement deprecated-variable.late.replacement)
76 (with-test (:name (sb-int:define-deprecated-variable :late))
77 (test 'variable 'deprecated-variable.late :late
78 (lambda (name) `(,name)))
79 (test 'variable 'deprecated-variable.late :late
80 (lambda (name) `((symbol-value ',name))))
81 (test 'variable 'deprecated-variable.late :late
82 (lambda (name) `((symbol-global-value ',name)))))
84 (sb-int:define-deprecated-variable :final "1.2.10"
85 deprecated-variable.final
86 :value :deprecated
87 :replacement deprecated-variable.final.replacement)
89 (with-test (:name (sb-int:define-deprecated-variable :final))
90 (test 'variable 'deprecated-variable.final :final
91 (lambda (name) `(,name)))
92 (test 'variable 'deprecated-variable.final :final
93 (lambda (name) `((symbol-value ',name))))
94 (test 'variable 'deprecated-variable.final :final
95 (lambda (name) `((symbol-global-value ',name)))))
98 ;;;; Deprecated functions
100 (sb-int:define-deprecated-function :early "1.2.10"
101 deprecated-function.early deprecated-function.early.replacement ()
102 :deprecated)
104 (with-test (:name (sb-int:define-deprecated-function :early))
105 (test 'function 'deprecated-function.early :early
106 (lambda (name) `((,name)))))
108 (sb-int:define-deprecated-function :late "1.2.10"
109 deprecated-function.late deprecated-function.late.replacement ()
110 :deprecated)
112 (with-test (:name (sb-int:define-deprecated-function :late))
113 (test 'function 'deprecated-function.late :late
114 (lambda (name) `((,name)))))
116 (sb-int:define-deprecated-function :final "1.2.10"
117 deprecated-function.final deprecated-function.final.replacement ()
118 :deprecated)
120 (with-test (:name (sb-int:define-deprecated-function :final))
121 (test 'function 'deprecated-function.final :final
122 (lambda (name) `((,name)))))
124 (sb-int:define-deprecated-function :early "1.2.10"
125 deprecated-function.two-replacements
126 (deprecated-function.two-replacements.replacement1
127 deprecated-function.two-replacements.replacement2)
129 :deprecated)
131 (with-test (:name (sb-int:define-deprecated-function :two-replacements))
132 (test
133 'function 'deprecated-function.two-replacements :early
134 (lambda (name) `((,name)))
135 :replacements '("DEPRECATED-FUNCTION.TWO-REPLACEMENTS.REPLACEMENT1"
136 "DEPRECATED-FUNCTION.TWO-REPLACEMENTS.REPLACEMENT2")))
138 (sb-int:define-deprecated-function :early "1.2.10"
139 deprecated-function.three-replacements
140 (deprecated-function.three-replacements.replacement1
141 deprecated-function.three-replacements.replacement2
142 deprecated-function.three-replacements.replacement3)
144 :deprecated)
146 (with-test (:name (sb-int:define-deprecated-function :three-replacements))
147 (test
148 'function 'deprecated-function.three-replacements :early
149 (lambda (name) `((,name)))
150 :replacements '("DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT1"
151 "DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT2"
152 "DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT3")))
154 (with-test (:name :deftype-tricky-constant)
155 (assert-signal (eval '(deftype cows () (if nil 'foo 'sb-thread::spinlock)))
156 warning))