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"
26 "Use" ,@replacements
"instead"))
27 (let ((match (search fragment string
:start2
(or start
0))))
29 (setf start
(+ match
(length fragment
))))))))
30 ;; Check the signaled warning condition.
33 (function (handler-bind
38 (compile nil
`(lambda ()
39 ,@(funcall make-body name
))))))
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
))
48 (assert (eq :deprecated
(funcall function
))))
50 (assert-error (funcall function
) deprecation-error
))))
51 ;; Check the documentation.
53 (search-string (documentation name kind
))))
55 ;;;; Deprecated variables
57 (sb-int:define-deprecated-variable
:early
"1.2.10"
58 deprecated-variable.early
60 :replacement deprecated-variable.early.replacement
)
62 (with-test (:name
(sb-int:define-deprecated-variable
:early
))
63 (check-deprecated-thing 'variable
'deprecated-variable.early
:early
64 (lambda (name) `(,name
)))
65 (check-deprecated-thing 'variable
'deprecated-variable.early
:early
66 (lambda (name) `((symbol-value ',name
))))
67 (check-deprecated-thing 'variable
'deprecated-variable.early
:early
68 (lambda (name) `((symbol-global-value ',name
)))))
70 (sb-int:define-deprecated-variable
:late
"1.2.10"
71 deprecated-variable.late
73 :replacement deprecated-variable.late.replacement
)
75 (with-test (:name
(sb-int:define-deprecated-variable
:late
))
76 (check-deprecated-thing 'variable
'deprecated-variable.late
:late
77 (lambda (name) `(,name
)))
78 (check-deprecated-thing 'variable
'deprecated-variable.late
:late
79 (lambda (name) `((symbol-value ',name
))))
80 (check-deprecated-thing 'variable
'deprecated-variable.late
:late
81 (lambda (name) `((symbol-global-value ',name
)))))
83 (sb-int:define-deprecated-variable
:final
"1.2.10"
84 deprecated-variable.final
86 :replacement deprecated-variable.final.replacement
)
88 (with-test (:name
(sb-int:define-deprecated-variable
:final
))
89 (check-deprecated-thing 'variable
'deprecated-variable.final
:final
90 (lambda (name) `(,name
)))
91 (check-deprecated-thing 'variable
'deprecated-variable.final
:final
92 (lambda (name) `((symbol-value ',name
))))
93 (check-deprecated-thing 'variable
'deprecated-variable.final
:final
94 (lambda (name) `((symbol-global-value ',name
)))))
97 ;;;; Deprecated functions
99 (sb-int:define-deprecated-function
:early
"1.2.10"
100 deprecated-function.early deprecated-function.early.replacement
()
103 (with-test (:name
(sb-int:define-deprecated-function
:early
))
104 (check-deprecated-thing 'function
'deprecated-function.early
:early
105 (lambda (name) `((,name
)))))
107 (sb-int:define-deprecated-function
:late
"1.2.10"
108 deprecated-function.late deprecated-function.late.replacement
()
111 (with-test (:name
(sb-int:define-deprecated-function
:late
))
112 (check-deprecated-thing 'function
'deprecated-function.late
:late
113 (lambda (name) `((,name
)))))
115 (sb-int:define-deprecated-function
:final
"1.2.10"
116 deprecated-function.final deprecated-function.final.replacement
()
119 (with-test (:name
(sb-int:define-deprecated-function
:final
))
120 (check-deprecated-thing 'function
'deprecated-function.final
:final
121 (lambda (name) `((,name
)))))
123 (sb-int:define-deprecated-function
:early
"1.2.10"
124 deprecated-function.two-replacements
125 (deprecated-function.two-replacements.replacement1
126 deprecated-function.two-replacements.replacement2
)
130 (with-test (:name
(sb-int:define-deprecated-function
:two-replacements
))
131 (check-deprecated-thing
132 'function
'deprecated-function.two-replacements
:early
133 (lambda (name) `((,name
)))
134 :replacements
'("DEPRECATED-FUNCTION.TWO-REPLACEMENTS.REPLACEMENT1"
135 "DEPRECATED-FUNCTION.TWO-REPLACEMENTS.REPLACEMENT2")))
137 (sb-int:define-deprecated-function
:early
"1.2.10"
138 deprecated-function.three-replacements
139 (deprecated-function.three-replacements.replacement1
140 deprecated-function.three-replacements.replacement2
141 deprecated-function.three-replacements.replacement3
)
145 (with-test (:name
(sb-int:define-deprecated-function
:three-replacements
))
146 (check-deprecated-thing
147 'function
'deprecated-function.three-replacements
:early
148 (lambda (name) `((,name
)))
149 :replacements
'("DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT1"
150 "DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT2"
151 "DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT3")))