1.0.1.35: propagate (EQL X Y) constraints symmetrically

  After an (EQL X Y) test both X and Y shall inherit the constraints
  of the other. Thanks to jsnell for spotting this.

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 3bc7362..9f1e1f0 100644 (file)
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -447,7 +447,7 @@
       (do-eql-vars (var2 (var2 constraints))
         (inherit-constraints var1 var2 constraints target))
       (do-eql-vars (var1 (var1 constraints))
-        (inherit-constraints var1 var2 constraints target))
+        (inherit-constraints var2 var1 constraints target))
       t)))
 
 ;; Add an (EQL LAMBDA-VAR LAMBDA-VAR) constraint on VAR and LVAR's

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 7db4d3a..7952ae1 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2043,6 +2043,30 @@
       (compiler-note () (throw :note nil)))
     (error "Unreachable code undetected.")))
 
+(with-test (:name (:compiler :constraint-propagation :var-eql-to-var-1))
+  (catch :note
+    (handler-case
+        (compile nil '(lambda (x y)
+                        (when (typep y 'fixnum)
+                          (when (eql x y)
+                            (unless (typep x 'fixnum)
+                              (error "This is unreachable"))
+                            (setq y nil)))))
+      (compiler-note () (throw :note nil)))
+    (error "Unreachable code undetected.")))
+
+(with-test (:name (:compiler :constraint-propagation :var-eql-to-var-2))
+  (catch :note
+    (handler-case
+        (compile nil '(lambda (x y)
+                        (when (typep y 'fixnum)
+                          (when (eql y x)
+                            (unless (typep x 'fixnum)
+                              (error "This is unreachable"))
+                            (setq y nil)))))
+      (compiler-note () (throw :note nil)))
+    (error "Unreachable code undetected.")))
+
 ;; Reported by John Wiseman, sbcl-devel
 ;; Subject: [Sbcl-devel] float type derivation bug?
 ;; Date: Tue, 4 Apr 2006 15:28:15 -0700

diff --git a/version.lisp-expr b/version.lisp-expr
index 23c8902..6b82152 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.1.34"
+"1.0.1.35"