diff options
| author | Gabor Melis <mega@hotpop.com> | 2007-01-23 16:04:53 +0000 |
|---|---|---|
| committer | Gabor Melis <mega@hotpop.com> | 2007-01-23 16:04:53 +0000 |
| commit | 3c9981c71f4d0d2c5b5830486c4b9a35ab50a240 (patch) | |
| tree | 9b8fcba4357c8045e1cada56ff99a8db20148851 | |
| parent | 0e6e1b2a81134f1b45330fd6abe49e32020e409d (diff) | |
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.
| -rw-r--r-- | src/compiler/constraint.lisp | 2 | ||||
| -rw-r--r-- | tests/compiler.pure.lisp | 24 | ||||
| -rw-r--r-- | version.lisp-expr | 2 |
3 files changed, 26 insertions, 2 deletions
diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index 3bc736213..9f1e1f030 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 7db4d3ae7..7952ae1ec 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 23c89026c..6b8215280 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" |