test-deprecation.script 2.72 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
;;-*- Lisp -*-

(setf asdf::*asdf-version* "6.7.8")

(DBG "Check still-valid code")
(asdf::with-asdf-deprecation (:style-warning "7.0")
  (defun still-valid () t))
(does-not-signal deprecated-function-condition (eval '(still-valid)))
(does-not-signal deprecated-function-condition (compile () '(lambda () (still-valid))))

(defmacro check-deprecation (condition name body)
  `(let ((c (signals ,condition (eval ',body))))
     (assert-equal (deprecated-function-name c) ',name)))

(defmacro check-deprecation-warning (condition name body)
  `(progn
     (check-deprecation ,condition ,name ,body)
     (nest #+(or abcl (and ecl ecl-bytecmp) mkcl) (does-not-signal condition)
           #+ccl (signals ccl::compiler-warning)
           #-(or abcl ccl (and ecl ecl-bytecmp) mkcl)
           (check-deprecation ,condition ,name)
           (compile () '(lambda () ,body)))))

(defmacro check-deprecation-error (condition name body)
  `(progn
     (check-deprecation ,condition ,name ,body)
     (nest #+allegro (signals style-warning)
           #+(or cmucl (and ecl (not ecl-bytecmp))) (signals c::compiler-error)
           #+(or (and ecl ecl-bytecmp) mkcl) (does-not-signal condition)
           #+sbcl (signals simple-warning)
           #-(or allegro cmucl ecl mkcl sbcl)
           (check-deprecation ,condition ,name)
           (compile () '(lambda () ,body)))))

(defmacro check-deprecation-delete (condition name body)
  `(progn
     (check-deprecation ,condition ,name ,body)
     (nest #+(or cmucl (and ecl (not ecl-bytecmp))) (signals c::compiler-error)
           #+mkcl (errors compiler:compiler-error)
           #+sbcl (signals sb-c:compiler-error)
           #-(or cmucl (and ecl (not ecl-bytecmp)) mkcl sbcl)
           (check-deprecation ,condition ,name)
           (compile () '(lambda () ,body)))))

(DBG "Check style-warning")
(asdf::with-asdf-deprecation (:style-warning "6")
  (defun should-style-warn () t))
(check-deprecation-warning deprecated-function-style-warning should-style-warn (should-style-warn))

(DBG "Check warning")
(asdf::with-asdf-deprecation (:style-warning "5") ;; next-version 6 is warning...
  (defun should-warn () t))
(check-deprecation-warning deprecated-function-warning should-warn (should-warn))

(DBG "Check warning")
(asdf::with-asdf-deprecation (:style-warning "6.5") ;; next- next-version 6.7 is error!
  (defun should-error () t))
(check-deprecation-error deprecated-function-error should-error (should-error))

(DBG "Check delete")
(check-deprecation-delete
 deprecated-function-should-be-deleted (past-due-f past-due-m)
 (asdf::with-asdf-deprecation (:style-warning "6.7.1")
   ;; next- next- next-version 6.7.4 is delete!
   (defun past-due-f () t)
   (progn (foo))
   (defgeneric past-due-gf ())
   (defmethod past-due-m ())))