1.0.47.26: BEST-SUB-SOURCE-PATH should ignore quoted constants

  Not only can they be improper, they can also be cyclic.

  Fixes lp#767959.

diff --git a/NEWS b/NEWS
index 28dacdc..5adaafc 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -28,6 +28,8 @@ changes relative to sbcl-1.0.47:
     (lp#705690)
   * bug fix: redefining classes so that slot-definition classes change now
     engages the obsolete instance protocol. (lp#766271)
+  * bug fix: constant improper lists could break source coverage recording.
+    (lp#767959)
 
 changes in sbcl-1.0.47 relative to sbcl-1.0.46:
   * bug fix: fix mach port rights leaks in mach exception handling code on

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index b0b2600..fc33980 100644 (file)
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -75,9 +75,14 @@ otherwise evaluate ELSE and return its values. ELSE defaults to NIL."
       nil
       (labels ((sub (form)
                  (or (get-source-path form)
-                     (and (consp form)
-                          (some #'sub form)))))
-        (or (sub form)))))
+                     (when (consp form)
+                       (unless (eq 'quote (car form))
+                         (somesub form)))))
+               (somesub (forms)
+                 (when (consp forms)
+                   (or (sub (car forms))
+                       (somesub (cdr forms))))))
+        (sub form))))
 \f
 ;;;; BLOCK and TAGBODY
 

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 41b122e..c2223e7 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3859,3 +3859,11 @@
                        (delete x y :test #'eql))))
     (assert (equal (list #'sb-int:delq)
                    (ctu:find-named-callees fun)))))
+
+(with-test (:name :bug-767959)
+  ;; This used to signal an error.
+  (compile nil `(lambda ()
+                  (declare (optimize sb-c:store-coverage-data))
+                  (assoc
+                   nil
+                   '((:ordinary . ordinary-lambda-list))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index ebcafab..93d53f0 100644 (file)
--- 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.47.25"
+"1.0.47.26"