summaryrefslogtreecommitdiff
path: root/tests/unintern.impure.lisp
blob: a5e6d00909bb6e218984322f6a73fd7905fc4693 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
;;; Assert that "old" symbol tables do not cause garbage retention
;;; (even if pseudo-static!) because they get zero-filled.
;;; CL-USER's internals aren't empty, merely because of READINg this file.
;;; So use the externals, of which there should be none.
(defun extern (name)
  (let ((s (make-symbol name))
        (p *package*))
    (sb-impl::add-symbol (sb-impl::package-external-symbols *package*) s 'intern)
    (sb-impl::%set-symbol-package s p)
    s))

(with-test (:name :empty-package-starts-with-readonly-tables)
  (extern "X")
  (extern "Y")
  (extern "Z")
  (let ((wps (mapcar (lambda (name) (make-weak-pointer (find-symbol name)))
                     '("X" "Y" "Z"))))
    (unintern (find-symbol "Z"))
    (unintern (find-symbol "X"))
    (unintern (find-symbol "Y"))
    (sb-sys:scrub-control-stack)
    (gc)
    (assert (< (count-if #'weak-pointer-value wps) 3))))