[Sbcl-commits] master: use COMPONENT-TOPLEVELISH-P in CHECK-CONSISTENCY

[Nikodemus S. <de...@us...>]

The branch "master" has been updated in SBCL:
       via  1a2be5b0ccd48116c26850a8c069f88c82c7fc1b (commit)
      from  32d3b398d33736e61b51a14afca8c14decec4437 (commit)

- Log -----------------------------------------------------------------
commit 1a2be5b0ccd48116c26850a8c069f88c82c7fc1b
Author: Nikodemus Siivola <nik...@ra...>
Date:   Thu Dec 8 17:50:58 2011 +0200

    use COMPONENT-TOPLEVELISH-P in CHECK-CONSISTENCY
    
     Fixes lp#308921 -- bug was in the consistency checking, not the compiler
     itself.
---
 src/compiler/debug.lisp    |    3 +--
 tests/compiler.impure.lisp |   13 +++++++++++++
 2 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 15d3008..2997e90 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -463,8 +463,7 @@
      (let ((leaf (ref-leaf node)))
        (when (functional-p leaf)
          (if (eq (functional-kind leaf) :toplevel-xep)
-             (unless (eq (component-kind (block-component (node-block node)))
-                         :toplevel)
+             (unless (component-toplevelish-p (block-component (node-block node)))
                (barf ":TOPLEVEL-XEP ref in non-top-level component: ~S"
                      node))
              (check-fun-reached leaf node)))))
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 38690b4..230c2d0 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -2221,4 +2221,17 @@
     (assert (equal type1 (sb-kernel:%simple-fun-type g)))
     (assert (equal type0 (sb-kernel:%simple-fun-type h)))))
 
+(test-util:with-test (:name :bug-308921)
+  (let ((*check-consistency* t))
+    (ctu:file-compile
+     `((let ((exported-symbols-alist
+               (loop for symbol being the external-symbols of :cl
+                     collect (cons symbol
+                                   (concatenate 'string
+                                                "#"
+                                                (string-downcase symbol))))))
+         (defun hyperdoc-lookup (symbol)
+           (cdr (assoc symbol exported-symbols-alist)))))
+     :load nil)))
+
 ;;; success

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


hooks/post-receive
-- 
SBCL