tests/unintern.impure.lisp

   1
   2 ;;; Assert that "old" symbol tables do not cause garbage retention
   3 ;;; (even if pseudo-static!) because they get zero-filled.
   4 ;;; CL-USER's internals aren't empty, merely because of READINg this file.
   5 ;;; So use the externals, of which there should be none.
   6 (defun extern (name)
   7   (let ((s (make-symbol name))
   8         (p *package*))
   9     (sb-impl::add-symbol (sb-impl::package-external-symbols *package*) s)
  10     (sb-impl::%set-symbol-package s p)
  11     s))
  12
  13 (with-test (:name :empty-package-starts-with-readonly-tables)
  14   (extern "X")
  15   (extern "Y")
  16   (extern "Z")
  17   (let ((wps (mapcar (lambda (name) (make-weak-pointer (find-symbol name)))
  18                      '("X" "Y" "Z"))))
  19     (unintern (find-symbol "Z"))
  20     (unintern (find-symbol "X"))
  21     (unintern (find-symbol "Y"))
  22     (sb-sys:scrub-control-stack)
  23     (gc)
  24     (assert (< (count-if #'weak-pointer-value wps) 3))))