mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
559f9e0049
- Capture before/after state of globaldb and global symbols for comparison. - Do a better job clobbering remants of defining forms after each test file. - Allow DEFSTRUCT and DEFTYPE in pure tests. The intent of this change is to get a larger set of tests that don't fork a new child, which will provide more metrics on the effectiveness of GC during the regression run. Contrary to the comments, DEFUN and DEFMACRO do not render a test impure, because DELETE-PACKAGE undoes those. Apparently thread creation is treated as pure, evidenced by the mere existence of 'threads.pure.lisp'. Also, creating a file is not impure, because state change outside the process is usually irrelevant. A failing pure test may have side-effects by accident, which isn't great, but we can live with it.
52 lines
2.1 KiB
Common Lisp
52 lines
2.1 KiB
Common Lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(defvar *breadcrumbs* nil))
|
|
|
|
(defglobal **a-global**
|
|
(progn (push 'global-initform *breadcrumbs*) 'foo1))
|
|
|
|
(define-load-time-global **a-load-time-global**
|
|
(progn (push 'ltg-initform *breadcrumbs*) 'foo2))
|
|
|
|
(eval-when (:compile-toplevel)
|
|
;; In the compiler, DEFGLOBAL evals its value form at compile-time
|
|
;; DEFINE-LOAD-TIME-GLOBAL does not
|
|
(assert (equal *breadcrumbs* '(global-initform)))
|
|
(assert (eq (sb-int:info :variable :always-bound '**a-global**)
|
|
:always-bound))
|
|
(assert (eq (sb-int:info :variable :always-bound '**a-load-time-global**)
|
|
:eventually)))
|
|
|
|
(eval-when (:compile-toplevel :load-toplevel)
|
|
(defun test-use-ltg () (null **a-load-time-global**))
|
|
;; At compile-time, the load-time-global should be unbound,
|
|
;; and importantly the function that was compiled that uses
|
|
;; it should signal an error. The latter implies the former
|
|
;; so we needn't check both assertions.
|
|
(eval-when (:compile-toplevel)
|
|
(assert (eq :win (handler-case (test-use-ltg) (error () :win))))))
|
|
|
|
(with-test (:name :load-time-global-1)
|
|
(assert (equal *breadcrumbs* '(ltg-initform global-initform)))
|
|
|
|
;; Can not legally make **a-load-time-global** unbound
|
|
(assert (eq :win (handler-case (makunbound '**a-load-time-global**)
|
|
(error () :win))))
|
|
|
|
;; Make it unbound "illegally" which will give circumstantial evidence
|
|
;; that the function accessing it has assumed :ALWAYS-BOUND.
|
|
(sb-impl::%makunbound '**a-load-time-global**)
|
|
|
|
;; Finally, verify that TEST-USE-GLOBAL2 does *NOT* contain the boundp
|
|
;; check. It just returns NIL because the unbound marker is not EQ to nil.
|
|
(assert (not (test-use-ltg))))
|
|
|
|
;; :ALWAYS-BOUND takes precedence over :EVENTUALLY
|
|
(defglobal **anotherone** 3)
|
|
(define-load-time-global **anotherone** 4)
|
|
(eval-when (:compile-toplevel)
|
|
;; Assert that the second of those two forms did basically nothing.
|
|
(assert (eq (sb-int:info :variable :always-bound '**anotherone**)
|
|
:always-bound)))
|
|
(with-test (:name :load-time-global-2)
|
|
(assert (eql **anotherone** 3)))
|