From d7e55b414d180341d79e0eddc957e1aa52551c38 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Tue, 13 Dec 2011 13:26:05 -0500 Subject: [PATCH] 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. --- src/compiler/constraint.lisp | 7 ++----- tests/compiler.pure.lisp | 7 +++++++ tests/dynamic-extent.impure.lisp | 2 +- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index fae2b81..550f9b9 100644 --- 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 --- 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 --- 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)) -- 1.7.10.4