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