1.0.30.43: LVAR-MATCHES needs to deal with unnamed leaves

 ...by passing ERRORP=NIL to COMBINATION-FUN-SOURCE-NAME. Also smooth
 the return value convention of C-F-S-N by adding a secondary value:
 NIL is a valid name for a local function.

 See: https://bugs.launchpad.net/sbcl/+bug/411563

diff --git a/NEWS b/NEWS
index fea08fb..6ba10e8 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -50,6 +50,8 @@ changes relative to sbcl-1.0.30:
     Elsasser)
   * improvement: pretty-printing of various Lisp forms has been improved
     (thanks to Tobias Rittweiler)
+  * bug fix: a failing AVER compiling certain MAKE-ARRAY forms. (reported
+    by James Wright)
   * bug fix: some out-of-line array predicates were missing (reported by
     Stelian Ionescu)
   * bug fix: a failing AVER in CONVERT-MV-CALL has been fixed. (thanks to

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index b9ea816..f27b60d 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1961,12 +1961,13 @@ is :ANY, the function name is not checked."
         (name1 uses)
         (mapcar #'name1 uses)))))
 
-;;; Return the source name of a combination. (This is an idiom
-;;; which was used in CMU CL. I gather it always works. -- WHN)
+;;; Return the source name of a combination -- or signals an error
+;;; if the function leaf is anonymous.
 (defun combination-fun-source-name (combination &optional (errorp t))
   (let ((leaf (ref-leaf (lvar-uses (combination-fun combination)))))
-    (when (or errorp (leaf-has-source-name-p leaf))
-      (leaf-source-name leaf))))
+    (if (or errorp (leaf-has-source-name-p leaf))
+        (values (leaf-source-name leaf) t)
+        (values nil nil))))
 
 ;;; Return the COMBINATION node that is the call to the LET FUN.
 (defun let-combination (fun)
@@ -2193,7 +2194,8 @@ is :ANY, the function name is not checked."
   (let ((use (lvar-use lvar)))
     (and (combination-p use)
          (or (not fun-names)
-             (member (combination-fun-source-name use)
-                     fun-names :test #'eq))
+             (multiple-value-bind (name ok)
+                 (combination-fun-source-name use nil)
+               (and ok (member name fun-names :test #'eq))))
          (or (not arg-count)
              (= arg-count (length (combination-args use)))))))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 48cf250..3628419 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3261,3 +3261,9 @@
     (assert (not (search "GENERIC"
                          (with-output-to-string (out)
                            (disassemble d :stream out)))))))
+
+(with-test (:name :make-array-unnamed-dimension-leaf)
+  (let ((fun (compile nil `(lambda (stuff)
+                             (make-array (map 'list 'length stuff))))))
+    (assert (equalp #2A((0 0 0) (0 0 0))
+                    (funcall fun '((1 2) (1 2 3)))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 189db65..7caa597 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,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.30.42"
+"1.0.30.43"