From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sat, 12 Feb 2011 15:45:38 +0000 (+0000)
Subject: 1.0.45.26: fix a long-standing UNINTERN bug
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8b44c2ab1f8608780991b5695b06bad59005fbb1;p=sbcl.git

1.0.45.26: fix a long-standing UNINTERN bug

  Patch by Stas Boukarev, lp#693796.

  UNINTERN is specified to take a symbol, not a symbol
  designator: if P1 has the symbol P1:S, which is not EQ
  to P2:S, then (UNINTERN 'P2:S :P1) should not remove
  P1:S from P1.
---

diff --git a/NEWS b/NEWS
index 738319c..b3bb6e3 100644
--- a/NEWS
+++ b/NEWS
@@ -18,6 +18,8 @@ changes relative to sbcl-1.0.45:
     mistake. (lp#667297).
   * bug fix: CONSTANTLY generated functions had bogus lambda-lists. (lp#713626)
   * bug fix: RUN-PROGRAM :PTY option was racy on OpenBSD. (lp#669485)
+  * bug fix: UNINTERN takes a symbol, not a symbol designator -- could previously
+    unintern the wrong symbol with the same name. (lp#693796)
 
 changes in sbcl-1.0.45 relative to sbcl-1.0.44:
   * enhancement: ~/ and ~user/ are treated specially in pathnames.
diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index ccaa5bb..7efbdff 100644
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -967,8 +967,8 @@ uninterned."
                 (remove symbol shadowing-symbols)))
 
         (multiple-value-bind (s w) (find-symbol name package)
-          (declare (ignore s))
-          (cond ((or (eq w :internal) (eq w :external))
+          (cond ((not (eq symbol s)) nil)
+                ((or (eq w :internal) (eq w :external))
                  (nuke-symbol (if (eq w :internal)
                                   (package-internal-symbols package)
                                   (package-external-symbols package))
diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp
index db5c3b2..3b5273e 100644
--- a/tests/packages.impure.lisp
+++ b/tests/packages.impure.lisp
@@ -272,6 +272,11 @@ if a restart was invoked."
       (is (eq (sym "FOO" "SYM")
               (sym "BAZ" "SYM"))))))
 
+(with-test (:name unintern.2)
+  (with-packages (("FOO" (:intern "SYM")))
+    (unintern :sym "FOO")
+    (assert (find-symbol "SYM" "FOO"))))
+
 ;;; WITH-PACKAGE-ITERATOR error signalling had problems
 (with-test (:name with-package-itarator.error)
   (assert (eq :good
diff --git a/tests/with-compilation-unit.impure.lisp b/tests/with-compilation-unit.impure.lisp
index 1239f67..1a964a9 100644
--- a/tests/with-compilation-unit.impure.lisp
+++ b/tests/with-compilation-unit.impure.lisp
@@ -100,7 +100,7 @@
     (write `(defun bar () (typep 1 ',(intern "A-TYPE"))) :stream stream))
 
   (test-files (lambda ()
-                (unintern 'a-type)
+                (unintern (find-symbol "A-TYPE"))
                 (fmakunbound 'bar))))
 
 (delete-file *file-a*)
diff --git a/version.lisp-expr b/version.lisp-expr
index 182bfd6..42be45e 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.45.25"
+"1.0.45.26"