master: Fix KEEP-OLD restart in ADD-PACKAGE-LOCAL-NICKNAME

scymtym via Sbcl-commits <[email protected]> Sat, 16 May 2026 10:39:45 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  7aee69c49543c768256c96b0306e0c531f2238ce (commit)
      from  a8ba1ef64f5187b14e4ada7234264556eb327e60 (commit)

- Log -----------------------------------------------------------------
commit 7aee69c49543c768256c96b0306e0c531f2238ce
Author: Jan Moringen <[email protected]>
Date:   Sat May 16 11:48:31 2026 +0200

    Fix KEEP-OLD restart in ADD-PACKAGE-LOCAL-NICKNAME
---
 NEWS                         |  3 +++
 src/code/target-package.lisp |  8 ++++----
 tests/packages.impure.lisp   | 10 ++++++++++
 3 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index c2383af42..3b8ee6acd 100644
--- a/NEWS
+++ b/NEWS
@@ -7,6 +7,9 @@ changes relative to sbcl-2.6.4:
     uninitialized structure slot is no longer a TYPE-ERROR.
   * bug fix: strings of arbitrary size with fill-pointer set to 1 are
     character designators.  (reported by _death)
+  * 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).
 
 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 97135bea5..85c5c8e38 100644
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -1051,10 +1051,10 @@ Experimental: interface subject to change."
                already nickname for ~A.~:@>"
               nick (package-name actual) (package-name package) (package-name old-actual))
           (keep-old ()
-           :report (lambda (s)
-                     (format s "Keep ~A as local nickname for ~A."
-                             nick (package-name old-actual))
-                     (return-from %add-package-local-nickname package)))
+            :report (lambda (s)
+                      (format s "Keep ~A as local nickname for ~A."
+                              nick (package-name old-actual)))
+            (return-from %add-package-local-nickname package))
           (change-nick ()
             :report (lambda (s)
                       (format s "Use ~A as local nickname for ~A instead."
diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp
index 574d5d4ff..fdaf7040e 100644
--- a/tests/packages.impure.lisp
+++ b/tests/packages.impure.lisp
@@ -738,6 +738,16 @@ if a restart was invoked."
                 (let ((*package* p1))
                   (intern "FOO" :own-nickname))))))
 
+(with-test (:name (add-package-local-nickname :nickname-conflict :restart :keep-old))
+  (with-tmp-packages ((p1 (make-package "NICKNAME-CONFLICT1"))
+                      (p2 (make-package "NICKNAME-CONFLICT2"))
+                      (p3 (make-package "NICKNAME-CONFLICT3")))
+    (assert (eq p3 (add-package-local-nickname #1="N" p1 p3)))
+    (handler-bind ((error (lambda (condition)
+                            (invoke-restart 'sb-impl::keep-old))))
+      (assert (eq p3 (add-package-local-nickname #1# p2 p3))))
+    (assert (eq p1 (cdr (assoc "N" (package-local-nicknames p3) :test #'string=))))))
+
 (defun random-package-name (min max)
   (let* ((s (make-string (+ min (random (- max min))))))
     (dotimes (i (length s) s)

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL