Fix EQL constraint propagation on constant assigned closure variables

 * Constant lvars can now be references to assigned-to closure-
   converted lambda-vars, which don't have consets.  Just always use
   lvar-value, at the cost of a slight potential slowdown due to more
   calls to find-constant.

   Reported by Eric Marsden on sbcl-devel.

 * Also, canonicalize whitespace in dynamic-extent tests.

 Fixes lp#903838.

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index fae2b81..550f9b9 100644 (file)
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -585,7 +585,7 @@
     (precise-add-test-constraint fun x y not-p constraints
                                 consequent-constraints)
     (precise-add-test-constraint fun x y (not not-p) constraints
-                         alternative-constraints))
+                                 alternative-constraints))
   (values))
 
 (defun quick-add-complement-constraints (fun x y not-p
@@ -669,10 +669,7 @@
                            (add 'eql var1 var2 nil))
                           ((constant-lvar-p arg2)
                            (add 'eql var1
-                                (let ((use (principal-lvar-use arg2)))
-                                  (if (ref-p use)
-                                      (ref-leaf use)
-                                      (find-constant (lvar-value arg2))))
+                                (find-constant (lvar-value arg2))
                                 nil))
                           (t
                            (add-test-constraint quick-p

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 27d1028..81fc0f7 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4160,3 +4160,10 @@
                    (lambda (bar &optional quux)
                      (declare (dynamic-extent bar quux))
                      (foo bar quux))))))
+
+(with-test (:name :cprop-with-constant-but-assigned-to-closure-variable)
+  (compile nil `(lambda (b c d)
+                  (declare (type (integer -20545789 207590862) c))
+                  (declare (type (integer -1 -1) d))
+                  (let ((i (unwind-protect 32 (shiftf d -1))))
+                    (or (if (= d c)  2 (= 3 b)) 4)))))

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index a74c186..a1458bf 100644 (file)
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -577,7 +577,7 @@
   (assert-no-consing (vector-on-stack :x :y)))
 
 (with-test (:name (:no-consing :specialized-dx-vectors)
-           :fails-on '(and :sunos :x86)
+            :fails-on '(and :sunos :x86)
             :skipped-on `(not (and :stack-allocatable-vectors
                                    :c-stack-is-control-stack)))
   (assert-no-consing (make-array-on-stack-6))