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