[Sbcl-commits] master: fix APROPOS/APROPOS-LIST and inherited symbols

[Christophe R. <cr...@us...>]

The branch "master" has been updated in SBCL:
       via  844efffa77733395addf22261d31ef4a9de0a9f8 (commit)
      from  c82cc623c8af54cb309de7b77da9519950947298 (commit)

- Log -----------------------------------------------------------------
commit 844efffa77733395addf22261d31ef4a9de0a9f8
Author: Christophe Rhodes <cs...@ca...>
Date:   Thu Oct 23 12:12:48 2014 +0100

    fix APROPOS/APROPOS-LIST and inherited symbols
    
    lp#1364413; thanks to Zach Beane.
---
 NEWS                         |    2 ++
 src/code/target-package.lisp |   10 +++++-----
 tests/interface.impure.lisp  |   20 ++++++++++++++++++++
 3 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index ba8d4e6..7b2e33c 100644
--- a/NEWS
+++ b/NEWS
@@ -18,6 +18,8 @@ changes relative to sbcl-1.2.4:
   * bug fix: in interpreted code, inequality predicates did not type-check
     arguments that weren't examined, and a 1-argument use of MIN or MAX
     accepted a complex number. (lp#1373702)
+  * bug fix: APROPOS and APROPOS-LIST handle inherited symbols correctly.
+    (lp#1364413, thanks to Zach Beane)
 
 changes in sbcl-1.2.4 relative to sbcl-1.2.3:
   * enhancement: the sequence functions MAP, CONCATENATE and MERGE now call
diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 6d94a3f..76e7df6 100644
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -1554,11 +1554,11 @@ PACKAGE."
             (string (stringify-string-designator string-designator))
             (result nil))
         (do-symbols (symbol package)
-          (when (and (eq (symbol-package symbol) package)
-                     (or (not external-only)
-                         (eq (nth-value 1 (find-symbol (symbol-name symbol)
-                                                       package))
-                             :external))
+          (when (and (or (not external-only)
+                         (and (eq (symbol-package symbol) package)
+                              (eq (nth-value 1 (find-symbol (symbol-name symbol)
+                                                            package))
+                                  :external)))
                      (search string (symbol-name symbol) :test #'char-equal))
             (push symbol result)))
         (sort result #'string-lessp))
diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp
index e59213f..bcfa8e6 100644
--- a/tests/interface.impure.lisp
+++ b/tests/interface.impure.lisp
@@ -407,4 +407,24 @@
                   (assert (= (traced-gf 3) 4)))))
     (assert (= (length output) 0))))
 
+(with-test (:name (apropos :inherited :bug-1364413))
+  (let* ((package (make-package "BUGGALO" :use nil))
+         (symbol (intern "BUGGALO" package)))
+    (export (list symbol) package)
+    (let ((inherits (make-package "BUGGALO-INHERITS" :use (list package))))
+      (assert (= (length (apropos-list "BUGGALO" package)) 1))
+      (assert (= (length (apropos-list "BUGGALO" inherits)) 1))
+      (delete-package inherits))
+    (delete-package package)))
+
+(with-test (:name (apropos :inherited :external-only :bug-1364413))
+  (let* ((package (make-package "BUGGALO" :use nil))
+         (symbol (intern "BUGGALO" package)))
+    (export (list symbol) package)
+    (let ((inherits (make-package "BUGGALO-INHERITS" :use (list package))))
+      (assert (= (length (apropos-list "BUGGALO" package t)) 1))
+      (assert (= (length (apropos-list "BUGGALO" inherits t)) 0))
+      (delete-package inherits))
+    (delete-package package)))
+
 ;;;; success

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


hooks/post-receive
-- 
SBCL