From 2eee1c446adf860571a0d5e89eb5c547806cda76 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 7 Oct 2003 10:23:30 +0000 Subject: [PATCH] 0.8.4.9: Fix bug in CONS types/SUBTYPEP ... actually a bug in the CONS :SIMPLE-INTERSECTION2 type method, which wasn't doing enough work when one of the types produced a useful intersection and the other not. --- NEWS | 2 ++ src/code/late-type.lisp | 23 +++++++++++++++-------- tests/type.impure.lisp | 8 ++++++++ version.lisp-expr | 2 +- 4 files changed, 26 insertions(+), 9 deletions(-) diff --git a/NEWS b/NEWS index 68014ed..d57ed10 100644 --- a/NEWS +++ b/NEWS @@ -2129,6 +2129,8 @@ changes in sbcl-0.8.5 relative to sbcl-0.8.4: interval, containing 0. ** ASH of a negative bignum by a negative bignum count now returns -1, not 0. + ** intersection of CONS types now canonicalizes properly, fixing + inconsistencies in SUBTYPEP. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index b2cedaf..930ea76 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -2810,14 +2810,21 @@ (!define-type-method (cons :simple-intersection2) (type1 type2) (declare (type cons-type type1 type2)) - (let (car-int2 - cdr-int2) - (and (setf car-int2 (type-intersection2 (cons-type-car-type type1) - (cons-type-car-type type2))) - (setf cdr-int2 (type-intersection2 (cons-type-cdr-type type1) - (cons-type-cdr-type type2))) - (make-cons-type car-int2 cdr-int2)))) - + (let ((car-int2 (type-intersection2 (cons-type-car-type type1) + (cons-type-car-type type2))) + (cdr-int2 (type-intersection2 (cons-type-cdr-type type1) + (cons-type-cdr-type type2)))) + (cond + ((and car-int2 cdr-int2) (make-cons-type car-int2 cdr-int2)) + (car-int2 (make-cons-type car-int2 + (type-intersection + (cons-type-cdr-type type1) + (cons-type-cdr-type type2)))) + (cdr-int2 (make-cons-type + (type-intersection (cons-type-car-type type1) + (cons-type-car-type type2)) + cdr-int2))))) + ;;; Return the type that describes all objects that are in X but not ;;; in Y. If we can't determine this type, then return NIL. ;;; diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp index 6e4a2e8..38cee27 100644 --- a/tests/type.impure.lisp +++ b/tests/type.impure.lisp @@ -409,6 +409,14 @@ (t1 (sb-kernel:specifier-type s))) (eval `(defstruct ,s)) (sb-kernel:type= t1 (sb-kernel:specifier-type s)))) + +;;; bug found by PFD's random subtypep tester +(let ((t1 '(cons rational (cons (not rational) (cons integer t)))) + (t2 '(not (cons (integer 0 1) (cons single-float long-float))))) + (assert-t-t (subtypep t1 t2)) + (assert-nil-t (subtypep t2 t1)) + (assert-t-t (subtypep `(not ,t2) `(not ,t1))) + (assert-nil-t (subtypep `(not ,t1) `(not ,t2)))) ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 8e856ab..e3d38c5 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".) -"0.8.4.8" +"0.8.4.9" -- 1.7.10.4