tests/defglobal.impure-cload.lisp

   1 (eval-when (:compile-toplevel :load-toplevel :execute)
   2   (defvar *breadcrumbs* nil))
   3
   4 (defglobal **a-global**
   5   (progn (push 'global-initform *breadcrumbs*) 'foo1))
   6
   7 (define-load-time-global **a-load-time-global**
   8   (progn (push 'ltg-initform *breadcrumbs*) 'foo2))
   9
  10 (eval-when (:compile-toplevel)
  11   ;; In the compiler, DEFGLOBAL evals its value form at compile-time
  12   ;; DEFINE-LOAD-TIME-GLOBAL does not
  13   (assert (equal *breadcrumbs* '(global-initform)))
  14   (assert (eq (sb-int:info :variable :always-bound '**a-global**)
  15               :always-bound))
  16   (assert (eq (sb-int:info :variable :always-bound '**a-load-time-global**)
  17               :eventually)))
  18
  19 (eval-when (:compile-toplevel :load-toplevel)
  20   (defun test-use-ltg () (null **a-load-time-global**))
  21   ;; At compile-time, the load-time-global should be unbound,
  22   ;; and importantly the function that was compiled that uses
  23   ;; it should signal an error. The latter implies the former
  24   ;; so we needn't check both assertions.
  25   (eval-when (:compile-toplevel)
  26     (assert (eq :win (handler-case (test-use-ltg) (error () :win))))))
  27
  28 (test-util:with-test (:name :load-time-global-1)
  29   (assert (equal *breadcrumbs* '(ltg-initform global-initform)))
  30
  31   ;; Can not legally make **a-load-time-global** unbound
  32   (assert (eq :win (handler-case (makunbound '**a-load-time-global**)
  33                      (error () :win))))
  34
  35   ;; Make it unbound "illegally" which will give circumstantial evidence
  36   ;; that the function accessing it has assumed :ALWAYS-BOUND.
  37   (sb-impl::%makunbound '**a-load-time-global**)
  38
  39   ;; Finally, verify that TEST-USE-GLOBAL2 does *NOT* contain the boundp
  40   ;; check. It just returns NIL because the unbound marker is not EQ to nil.
  41   (assert (not (test-use-ltg))))
  42
  43 ;; :ALWAYS-BOUND takes precedence over :EVENTUALLY
  44 (defglobal **anotherone** 3)
  45 (define-load-time-global **anotherone** 4)
  46 (eval-when (:compile-toplevel)
  47   ;; Assert that the second of those two forms did basically nothing.
  48   (assert (eq (sb-int:info :variable :always-bound '**anotherone**)
  49               :always-bound)))
  50 (test-util:with-test (:name :load-time-global-2)
  51   (assert (eql **anotherone** 3)))