common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Add failing tests.

Browse source
This commit is contained in:
Charles Zhang 2022-06-02 21:34:27 -07:00
parent 83fab73168
commit 3d71e628f1
6 changed files with 80 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
tests/block-compile.impure.lisp
View file

@ -122,6 +122,36 @@
:load t)
(assert (find-symbol "STABLE-UNION" "BLOCK-DEFPACKAGE-BAR")))
(with-test (:name :block-defpackage-rename-package-symbol-conflict
:fails-on :sbcl)
(with-scratch-file (fasl2 "fasl")
(compile-file "package-test-2.lisp" :output-file fasl2
:block-compile t)
(delete-package "BAR")
(with-scratch-file (fasl1 "fasl")
(compile-file "package-test-1.lisp" :output-file fasl1
:block-compile t)
(load fasl2)))
(assert (eq (symbol-package (find-symbol "BAZ" "BAR"))
(find-package "BAR")))
(assert (eq (funcall (find-symbol "BAZ" "BAR"))
:good))
(delete-package "BAR"))
(with-test (:name :block-defpackage-rename-package-preserve-externals
:fails-on :sbcl)
(with-scratch-file (fasl4 "fasl")
(compile-file "package-test-4.lisp" :output-file fasl4
:block-compile t)
(delete-package "FOO-NEW")
(with-scratch-file (fasl3 "fasl")
(compile-file "package-test-3.lisp" :output-file fasl3
:block-compile t)
(load fasl4)))
(assert (eq (nth-value 1 (find-symbol "BAR" "FOO-NEW"))
:external))
(delete-package "FOO-NEW"))
(with-test (:name :block-defconstant-then-load-fasl)
(ctu:file-compile
;; test a non-EQL-comparable constant.

5
tests/input-manifest.lisp-expr
View file

@ -40,6 +40,11 @@
"tests/block-compile-test-4.lisp"
"tests/block-compile-test-5.lisp")
("debug.impure.lisp" "tests/bug-414.lisp")
("block-compile.impure.lisp"
"tests/package-test-1.lisp"
"tests/package-test-2.lisp"
"tests/package-test-3.lisp"
"tests/package-test-4.lisp")
("defstruct.impure-cload.lisp" "tests/block-compile-defstruct-test.lisp")
("elfcore.test.sh" "src/runtime/shrinkwrap-sbcl")
("exit-hang.impure.lisp" "tests/fcb-threads.so")

8
tests/package-test-1.lisp Normal file
View file

@ -0,0 +1,8 @@
(defpackage "FOO"
(:use "CL"))
(in-package "FOO")
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun baz ()
:bad))

13
tests/package-test-2.lisp Normal file
View file

@ -0,0 +1,13 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(cond
((find-package "FOO")
(rename-package "FOO" "BAR" '("FOO")))
((not (find-package "BAR"))
(make-package "BAR" :use '("CL") :nicknames '("FOO"))
(export (list (intern "BAZ" "BAR")) "BAR"))))
(in-package "BAR")
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun baz ()
:good))

11
tests/package-test-3.lisp Normal file
View file

@ -0,0 +1,11 @@
(defpackage "FOO"
(:use "CL")
(:export "BAR" "BAZ"))
(in-package "FOO")
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun baz ()
1)
(defmacro bar (&rest args)
`(baz ,@args)))

13
tests/package-test-4.lisp Normal file
View file

@ -0,0 +1,13 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(cond
((find-package "FOO")
(rename-package "FOO" "FOO-NEW" '("FOO")))
((not (find-package "FOO-NEW"))
(make-package "FOO-NEW" :use '("CL") :nicknames '("FOO"))
(export (list (intern "BAR" "FOO-NEW") (intern "BAZ" "FOO-NEW")) "FOO-NEW"))))
(in-package "FOO-NEW")
(eval-when (:compile-toplevel :load-toplevel :execute)
(defmacro bar (&rest args)
`(baz ,@args)))