tests/deprecation.internal.impure.lisp

   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.
  11
  12 \f
  13 ;;;; Helpers
  14
  15 (defun test (kind name state make-body
  16                                &key (replacements
  17                                      (list (format nil "~A.~A"
  18                                                    name '#:replacement))))
  19   (flet ((search-string (string)
  20            (declare (ignorable string))
  21            (let ((start))
  22              (dolist (fragment `(,(string name)
  23                                   "deprecated" "as" "of" "SBCL" "1.2.10"
  24                                   "Use" ,@replacements "instead"))
  25                (let ((match (search fragment string :start2 (or start 0))))
  26                  (assert match)
  27                  (setf start (+ match (length fragment))))))))
  28     ;; Check the signaled warning condition.
  29     (let* ((condition)
  30            (count 0)
  31            (function (handler-bind
  32                          ((warning (lambda (c)
  33                                      (incf count)
  34                                      (setf condition c)
  35                                      (muffle-warning))))
  36                        (compile nil `(lambda ()
  37                                        ,@(funcall make-body name))))))
  38       (assert (= count 1))
  39       (assert (typep condition (ecase state
  40                                  (:early 'early-deprecation-warning)
  41                                  (:late 'late-deprecation-warning)
  42                                  (:final 'final-deprecation-warning))))
  43       (search-string (princ-to-string condition))
  44       (ecase state
  45         ((:early :late)
  46          (assert (eq :deprecated (funcall function))))
  47         (:final
  48          (assert-error (funcall function)
  49                        (or deprecation-error cell-error)))))
  50     ;; Check the documentation.
  51     #+sb-doc
  52     (search-string (documentation name kind))))
  53 \f
  54 ;;;; Deprecated variables
  55
  56 (sb-int:define-deprecated-variable :early "1.2.10"
  57   deprecated-variable.early
  58   :value :deprecated
  59   :replacement deprecated-variable.early.replacement)
  60
  61 (with-test (:name (sb-int:define-deprecated-variable :early))
  62   (test 'variable 'deprecated-variable.early :early
  63                           (lambda (name) `(,name)))
  64   (test 'variable 'deprecated-variable.early :early
  65                           (lambda (name) `((symbol-value ',name))))
  66   (test 'variable 'deprecated-variable.early :early
  67                           (lambda (name) `((symbol-global-value ',name)))))
  68
  69 (sb-int:define-deprecated-variable :late "1.2.10"
  70   deprecated-variable.late
  71   :value :deprecated
  72   :replacement deprecated-variable.late.replacement)
  73
  74 (with-test (:name (sb-int:define-deprecated-variable :late))
  75   (test 'variable 'deprecated-variable.late :late
  76                           (lambda (name) `(,name)))
  77   (test 'variable 'deprecated-variable.late :late
  78                           (lambda (name) `((symbol-value ',name))))
  79   (test 'variable 'deprecated-variable.late :late
  80                           (lambda (name) `((symbol-global-value ',name)))))
  81
  82 (sb-int:define-deprecated-variable :final "1.2.10"
  83   deprecated-variable.final
  84   :value :deprecated
  85   :replacement deprecated-variable.final.replacement)
  86
  87 (with-test (:name (sb-int:define-deprecated-variable :final))
  88   (test 'variable 'deprecated-variable.final :final
  89                           (lambda (name) `(,name)))
  90   (test 'variable 'deprecated-variable.final :final
  91                           (lambda (name) `((symbol-value ',name))))
  92   (test 'variable 'deprecated-variable.final :final
  93                           (lambda (name) `((symbol-global-value ',name)))))
  94
  95 \f
  96 ;;;; Deprecated functions
  97
  98 (sb-int:define-deprecated-function :early "1.2.10"
  99     deprecated-function.early deprecated-function.early.replacement ()
 100   :deprecated)
 101
 102 (with-test (:name (sb-int:define-deprecated-function :early))
 103   (test 'function 'deprecated-function.early :early
 104                           (lambda (name) `((,name)))))
 105
 106 (sb-int:define-deprecated-function :late "1.2.10"
 107     deprecated-function.late deprecated-function.late.replacement ()
 108   :deprecated)
 109
 110 (with-test (:name (sb-int:define-deprecated-function :late))
 111   (test 'function 'deprecated-function.late :late
 112                           (lambda (name) `((,name)))))
 113
 114 (sb-int:define-deprecated-function :final "1.2.10"
 115     deprecated-function.final deprecated-function.final.replacement ()
 116   :deprecated)
 117
 118 (with-test (:name (sb-int:define-deprecated-function :final))
 119   (test 'function 'deprecated-function.final :final
 120                           (lambda (name) `((,name)))))
 121
 122 (sb-int:define-deprecated-function :early "1.2.10"
 123     deprecated-function.two-replacements
 124     (deprecated-function.two-replacements.replacement1
 125      deprecated-function.two-replacements.replacement2)
 126     ()
 127   :deprecated)
 128
 129 (with-test (:name (sb-int:define-deprecated-function :two-replacements))
 130   (test
 131    'function 'deprecated-function.two-replacements :early
 132    (lambda (name) `((,name)))
 133    :replacements '("DEPRECATED-FUNCTION.TWO-REPLACEMENTS.REPLACEMENT1"
 134                    "DEPRECATED-FUNCTION.TWO-REPLACEMENTS.REPLACEMENT2")))
 135
 136 (sb-int:define-deprecated-function :early "1.2.10"
 137     deprecated-function.three-replacements
 138     (deprecated-function.three-replacements.replacement1
 139      deprecated-function.three-replacements.replacement2
 140      deprecated-function.three-replacements.replacement3)
 141     ()
 142   :deprecated)
 143
 144 (with-test (:name (sb-int:define-deprecated-function :three-replacements))
 145   (test
 146    'function 'deprecated-function.three-replacements :early
 147    (lambda (name) `((,name)))
 148    :replacements '("DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT1"
 149                    "DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT2"
 150                    "DEPRECATED-FUNCTION.THREE-REPLACEMENTS.REPLACEMENT3")))
 151
 152 (with-test (:name :deftype-tricky-constant)
 153   (assert-signal (eval '(deftype cows () (if nil 'foo 'sb-thread::spinlock)))
 154                  warning))