From 3c9981c71f4d0d2c5b5830486c4b9a35ab50a240 Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Tue, 23 Jan 2007 16:04:53 +0000 Subject: [PATCH] 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. --- src/compiler/constraint.lisp | 2 +- tests/compiler.pure.lisp | 24 ++++++++++++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 26 insertions(+), 2 deletions(-) diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index 3bc7362..9f1e1f0 100644 --- 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 --- 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 --- 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" -- 1.7.10.4