mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Some checks failed
Linux qemu / ppc64le (push) Failing after 0s
CL-host / ecl (push) Waiting to run
CL-host / clisp (push) Waiting to run
CL-host / ccl (push) Waiting to run
CL-host / cmucl (push) Waiting to run
CL-host / sbcl (push) Waiting to run
CL-host / compare-xc-host-fasls (ccl, false) (push) Blocked by required conditions
CL-host / compare-xc-host-fasls (clisp, false) (push) Blocked by required conditions
CL-host / compare-xc-host-fasls (cmucl, false) (push) Blocked by required conditions
CL-host / compare-xc-host-fasls (self, false) (push) Blocked by required conditions
Linux / build (x86, --with-sb-thread, ) (push) Waiting to run
Linux / build (x86, --without-sb-thread, ) (push) Waiting to run
Linux / build (x86, --without-sb-unicode, ) (push) Waiting to run
Linux / build (x86-64, --with-mark-region-gc) (push) Waiting to run
Linux / build (x86-64, --with-sb-fasteval --without-sb-eval, fasteval) (push) Waiting to run
Linux / build (x86-64, --with-sb-thread, ) (push) Waiting to run
Linux / build (x86-64, --with-sb-thread, sse4) (push) Waiting to run
Linux / build (x86-64, --without-sb-thread, ) (push) Waiting to run
Linux / build (x86-64, --without-sb-unicode, ) (push) Waiting to run
Mac / build (--without-sb-thread, x86-64) (push) Waiting to run
Mac / build (arm64, --with-mark-region-gc) (push) Waiting to run
Mac / build (arm64, --with-sb-thread) (push) Waiting to run
Mac / build (x86-64, --with-mark-region-gc) (push) Waiting to run
Mac / build (x86-64, --with-sb-thread) (push) Waiting to run
Windows / build (push) Waiting to run
Allow changing accessibility from :INTERNAL to :EXTERNAL during iteration without messing up the iterator. But now we have a duplicates problem which it's unclear whether runs slightly afoul of the spec. e.g. DO-ALL-SYMBOLS "may cause a symbol that is present in several packages to be processed more than once". Since that's not phrased as if-and-only-if, we take the liberty of returning a symbol more than once even when NOT present in more than one package. Apparently so do some other Common-Lisp implementations.
25 lines
884 B
Common Lisp
25 lines
884 B
Common Lisp
|
|
;;; 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))))
|