tests/macro-policy-decls.impure-cload.lisp

   1
   2 (defmacro get-policy (&rest args &environment env)
   3   (declare (ignore args))
   4   ;; Return the _ordinary_ compilation policy as a sexpr.
   5   ;; You can't detect the macro policy from a lexenv because the macro's ENV arg
   6   ;; is the policy for compiling target code, not for compiling the macro.
   7   (list 'quote
   8         ;; Test should pass irrespective of whether the baseline policy
   9         ;; asks for allocation profiling.
  10         (remove 'sb-c::instrument-consing
  11                 (sb-c::policy-to-decl-spec (sb-c::lexenv-policy env))
  12                 :key 'car)))
  13
  14 (declaim (optimize (speed 2) sb-c:store-coverage-data))
  15
  16 (with-test (:name :obey-declaim-1)
  17   (assert (equal (get-policy)
  18                  '((sb-c::inhibit-warnings 1)
  19                    (speed 2) (space 1) (safety 1) (debug 1)
  20                    (compilation-speed 1) (sb-c:store-coverage-data 3)))))
  21
  22 (eval-when (:compile-toplevel)
  23   (set-macro-policy '((speed 0) (safety 3))))
  24
  25 (with-test (:name :obey-declaim-2) ; *POLICY* is unchanged at this point
  26   (assert (equal (get-policy)
  27                  '((sb-c::inhibit-warnings 1)
  28                    (speed 2) (space 1) (safety 1) (debug 1)
  29                    (compilation-speed 1) (sb-c:store-coverage-data 3)))))
  30
  31 (declaim (optimize (speed 1) (sb-c:store-coverage-data 0)))
  32
  33 ;; Now it's changed
  34 (with-test (:name :obey-declaim-3)
  35   (assert (equal (get-policy)
  36                  '((sb-c::inhibit-warnings 1)
  37                    (speed 1) (space 1) (safety 1) (debug 1)
  38                    (compilation-speed 1) (sb-c:store-coverage-data 0)))))
  39
  40 ;; And again
  41 (declaim (optimize (sb-c:store-coverage-data 2)))
  42
  43 (with-test (:name :obey-declaim-4)
  44   (assert (equal (get-policy)
  45                  '((sb-c::inhibit-warnings 1)
  46                    (speed 1) (space 1) (safety 1) (debug 1)
  47                    (compilation-speed 1) (sb-c:store-coverage-data 2)))))