1.0.28.6: move the new PROGV tests to the right part of the file
[sbcl.git] / tests / compiler.impure.lisp
index ef9d8b0..06f52a5 100644 (file)
     (let ((usage-after (sb-kernel::dynamic-usage)))
       (when (< (+ usage-before 2000000) usage-after)
         (error "Leak")))))
+
+;;; PROGV compilation and type checking when the declared type
+;;; includes a FUNCTION subtype.
+(declaim (type (or (function (t) (values boolean &optional)) string)
+               *hairy-progv-var*))
+(defvar *hairy-progv-var* #'null)
+(with-test (:name :hairy-progv-type-checking)
+  (assert (eq :error
+              (handler-case
+                  (progv '(*hairy-progv-var*) (list (eval 42))
+                    *hairy-progv-var*)
+                (type-error () :error))))
+  (assert (equal "GOOD!"
+                 (progv '(*hairy-progv-var*) (list (eval "GOOD!"))
+                    *hairy-progv-var*))))
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
 (setf *mystery* :mystery)
 (assert (eq :ok (test-mystery (make-thing :slot :mystery))))
 
-;;; PROGV compilation and type checking when the declared type
-;;; includes a FUNCTION subtype.
-(declaim (type (or (function (t) (values boolean &optional)) string)
-               *hairy-progv-var*))
-(defvar *hairy-progv-var* #'null)
-(with-test (:name :hairy-progv-type-checking)
-  (assert (eq :error
-              (handler-case
-                  (progv '(*hairy-progv-var*) (list (eval 42))
-                    *hairy-progv-var*)
-                (type-error () :error))))
-  (assert (equal "GOOD!"
-                 (progv '(*hairy-progv-var*) (list (eval "GOOD!"))
-                    *hairy-progv-var*))))
 ;;; success