1 ;;;; This software is part of the SBCL system. See the README file for
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
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
)
17 (defun check-deprecated-thing (kind name state make-body
19 (list (format nil
"~A.~A"
20 name
'#:replacement
))))
21 (flet ((search-string (string)
22 (declare (ignorable string
))
24 (dolist (fragment `(,(string name
)
25 "deprecated" "as" "of" "SBCL" "1.2.10"
29 (assert (search fragment string
)))))
30 ;; Check the signaled warning condition.
32 (function (handler-bind
36 (compile nil
`(lambda ()
37 ,@(funcall make-body name
))))))
38 (assert (typep condition
(ecase state
39 (:early
'sb-int
:early-deprecation-warning
)
40 (:late
'sb-int
:late-deprecation-warning
)
41 (:final
'sb-int
:final-deprecation-warning
))))
42 (search-string (princ-to-string condition
))
45 (assert (eq :deprecated
(funcall function
))))
47 (assert-error (funcall function
) sb-int
:deprecation-error
))))
48 ;; Check the documentation.
49 (search-string (documentation name kind
))))
51 ;;;; Deprecated variables
53 (sb-impl::define-deprecated-variable
:early
"1.2.10"
54 deprecated-variable.early
56 :replacement deprecated-variable.early.replacement
)
58 (with-test (:name
(sb-impl::define-deprecated-variable
:early
))
59 (check-deprecated-thing 'variable
'deprecated-variable.early
:early
60 (lambda (name) `(,name
)))
61 (check-deprecated-thing 'variable
'deprecated-variable.early
:early
62 (lambda (name) `((symbol-value ',name
))))
63 (check-deprecated-thing 'variable
'deprecated-variable.early
:early
64 (lambda (name) `((symbol-global-value ',name
)))))
66 (sb-impl::define-deprecated-variable
:late
"1.2.10"
67 deprecated-variable.late
69 :replacement deprecated-variable.late.replacement
)
71 (with-test (:name
(sb-impl::define-deprecated-variable
:late
))
72 (check-deprecated-thing 'variable
'deprecated-variable.late
:late
73 (lambda (name) `(,name
)))
74 (check-deprecated-thing 'variable
'deprecated-variable.late
:late
75 (lambda (name) `((symbol-value ',name
))))
76 (check-deprecated-thing 'variable
'deprecated-variable.late
:late
77 (lambda (name) `((symbol-global-value ',name
)))))
79 (sb-impl::define-deprecated-variable
:final
"1.2.10"
80 deprecated-variable.final
82 :replacement deprecated-variable.final.replacement
)
84 (with-test (:name
(sb-impl::define-deprecated-variable
:final
))
85 (check-deprecated-thing 'variable
'deprecated-variable.final
:final
86 (lambda (name) `(,name
)))
87 (check-deprecated-thing 'variable
'deprecated-variable.final
:final
88 (lambda (name) `((symbol-value ',name
))))
89 (check-deprecated-thing 'variable
'deprecated-variable.final
:final
90 (lambda (name) `((symbol-global-value ',name
)))))
93 ;;;; Deprecated functions
95 (sb-impl::define-deprecated-function
:early
"1.2.10"
96 deprecated-function.early deprecated-function.early.replacement
()
99 (with-test (:name
(sb-impl::define-deprecated-function
:early
))
100 (check-deprecated-thing 'function
'deprecated-function.early
:early
101 (lambda (name) `((,name
)))))
103 (sb-impl::define-deprecated-function
:late
"1.2.10"
104 deprecated-function.late deprecated-function.late.replacement
()
107 (with-test (:name
(sb-impl::define-deprecated-function
:late
))
108 (check-deprecated-thing 'function
'deprecated-function.late
:late
109 (lambda (name) `((,name
)))))
111 (sb-impl::define-deprecated-function
:final
"1.2.10"
112 deprecated-function.final deprecated-function.final.replacement
()
115 (with-test (:name
(sb-impl::define-deprecated-function
:final
))
116 (check-deprecated-thing 'function
'deprecated-function.final
:final
117 (lambda (name) `((,name
)))))
119 (sb-impl::define-deprecated-function
:early
"1.2.10"
120 deprecated-function.two-replacements
121 (deprecated-function.two-replacements.replacement1
122 deprecated-function.two-replacements.replacement2
)
126 (with-test (:name
(sb-impl::define-deprecated-function
:two-replacements
))
127 (check-deprecated-thing
128 'function
'deprecated-function.two-replacements
:early
129 (lambda (name) `((,name
)))
130 :replacements
'("DEPRECATED-FUNCTION.TWO-REPLACEMENTS.REPLACEMENT1"
131 "DEPRECATED-FUNCTION.TWO-REPLACEMENTS.REPLACEMENT2")))
133 (sb-impl::define-deprecated-function
:early
"1.2.10"
134 deprecated-function.three-replacements
135 (deprecated-function.three-replacements.replacement1
136 deprecated-function.three-replacements.replacement2
137 deprecated-function.three-replacements.replacement3
)
141 (with-test (:name
(sb-impl::define-deprecated-function
:three-replacements
))
142 (check-deprecated-thing
143 'function
'deprecated-function.three-replacements
:early
144 (lambda (name) `((,name
)))
145 :replacements
'("DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT1"
146 "DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT2"
147 "DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT3")))
150 (sb-int:define-deprecated-function
:early
"1.2.10"
151 please-dont-use-this moar-better-function
(x) (identity x
))
152 (sb-int:define-deprecated-function
:late
"1.2.10"
153 really-dont-do-it use-other-thing-instead
(x) (identity x
))
154 (sb-int:define-deprecated-function
:final
"1.2.10"
155 you-cant-use-this replacement-fn
(x) (identity x
))
157 (with-test (:name
:introspect-deprecation-stage
)
158 (assert (eq (sb-int:deprecated-thing-p
:function
'please-dont-use-this
)
160 (assert (eq (sb-int:deprecated-thing-p
:function
'really-dont-do-it
)
162 (assert (eq (sb-int:deprecated-thing-p
:function
'you-cant-use-this
)
166 (with-test (:name
:late-deprecated-fun-doc
:skipped-on
'(not :sb-doc
))
167 (assert (string= (documentation 'you-cant-use-this
'function
)
168 (documentation #'you-cant-use-this
'function
)))
169 (assert (string= (documentation 'deprecated-function.late
'function
)
170 (documentation #'deprecated-function.late
'function
)))
171 (assert (string/= (documentation 'you-cant-use-this
'function
)
172 (documentation 'deprecated-function.late
'function
))))
174 (with-test (:name
:load-time-deprecation-warning
)
175 (let ((source "load-test.tmp") fasl
)
176 (with-open-file (f source
:direction
:output
177 :if-does-not-exist
:create
:if-exists
:supersede
)
178 (write-string "(defun a () (quit))" f
)
179 ;; a full warning even though the PLEASE-DONT- function is only :early
180 (write-string "(defun b () (please-dont-use-this) (really-dont-do-it))" f
)
181 (write-string "(defun c () (you-cant-use-this))" f
))
184 (let ((*error-output
* (make-broadcast-stream)))
185 (compile-file source
:verbose nil
:print nil
)))
186 (assert-signal (load fasl
) warning
))
188 (delete-file source
))))