master: Fix TAKE-NEW restart in EXPORT
scymtym via Sbcl-commits <[email protected]> Sun, 17 May 2026 17:57:53 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 2720527dfadc6ab004d9e6778ed35743aaa59a76 (commit)
from 7743b9db56b9f3bd5e548b0d1636f076be866a38 (commit)
- Log -----------------------------------------------------------------
commit 2720527dfadc6ab004d9e6778ed35743aaa59a76
Author: Jan Moringen <[email protected]>
Date: Sun May 17 15:06:48 2026 +0200
Fix TAKE-NEW restart in EXPORT
---
NEWS | 4 ++++
src/code/target-package.lisp | 25 +++++++++++++++++++++----
tests/packages.impure.lisp | 19 +++++++++++++++++++
3 files changed, 44 insertions(+), 4 deletions(-)
diff --git a/NEWS b/NEWS
index 3b8ee6acd..277400f57 100644
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,10 @@ changes relative to sbcl-2.6.4:
* bug fix: the KEEP-OLD restart established by ADD-PACKAGE-LOCAL-NICKNAME
keeps the old nickname instead of going ahead with the change (and the
restart report function no longer returns from ADD-PACKAGE-LOCAL-NICKNAME).
+ * bug fix: when EXPORT results in a conflict between symbols exported by
+ different used packages, the TAKE-NEW restart now shadowing-imports the
+ new symbol instead of doing nothing and leaving the package in an
+ inconsistent state.
changes in sbcl-2.6.4 relative to sbcl-2.6.3:
* minor incompatible change: when DEFSETF is called on a name that was
diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 85c5c8e38..14450bb08 100644
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -1548,15 +1548,32 @@ Experimental: interface subject to change."
:report (lambda (s)
(ecase function
(export
- (format s "Make ~S accessible in ~A (uninterning ~S)."
+ (format s "Make ~S accessible in ~A (uninterning or shadowing ~S)."
datum pname (old-symbol)))
(use-package
- (format s "Make ~S accessible in ~A (uninterning ~S)."
+ (format s "Make ~S accessible in ~A (uninterning or shadowing ~S)."
(car datum) pname (old-symbol)))))
:test use1-or-export-p
(dolist (s symbols)
- (when (eq s (find-symbol (symbol-name s) package))
- (unintern s package))))
+ (multiple-value-bind (accessible-symbol status)
+ (find-symbol (symbol-name s) package)
+ (cond ((and (eq accessible-symbol s)
+ (member status '(:internal :exported)))
+ ;; The symbol S is present in PACKAGE. Unintern
+ ;; to resolve the conflict.
+ (unintern s package))
+ ((eq status :inherited)
+ ;; Two symbols with the same symbol name would be
+ ;; inherited from different packages. This case
+ ;; happens when S is the "old" symbol which is
+ ;; currently inherited. Shadowing-import the
+ ;; "new" symbol to resolve the conflict.
+ (shadowing-import s package)
+ ;; Stop the iteration so that the "new" symbol
+ ;; which is now present in PACKAGE does not get
+ ;; uninterned again by the other case in the next
+ ;; iteration.
+ (return))))))
;; IMPORT with a pair of symbols conflicting.
(shadowing-import-it ()
:report (lambda (s)
diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp
index 2641450ed..b7efb515a 100644
--- a/tests/packages.impure.lisp
+++ b/tests/packages.impure.lisp
@@ -288,6 +288,25 @@ if a restart was invoked."
(is (= 1 (length result)))
(is (eql (sym "FOO" "SYM") (car result))))))))
+(with-test (:name (export :name-conflict :restart sb-impl::take-new))
+ (with-packages (("old-exporting" (:export "foo"))
+ ("new-exporting" (:intern "foo"))
+ ("using" (:use "old-exporting" "new-exporting")))
+ (let* ((old-exporting (find-package "old-exporting"))
+ (new-exporting (find-package "new-exporting"))
+ (using (find-package "using"))
+ (old-symbol (find-symbol "foo" old-exporting))
+ (new-symbol (find-symbol "foo" new-exporting)))
+ (assert (equal (list old-symbol :inherited)
+ (multiple-value-list (find-symbol "foo" using))))
+ (handler-bind ((sb-ext:name-conflict
+ (lambda (condition)
+ (declare (ignore condition))
+ (invoke-restart 'sb-impl::take-new))))
+ (export new-symbol new-exporting))
+ (assert (equal (list new-symbol :internal)
+ (multiple-value-list (find-symbol "foo" using)))))))
+
;;; IMPORT
(with-test (:name :import-nil.1)
(with-packages (("FOO" (:use) (:intern "NIL"))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL