From 44e8b1e878153bd815021acd962806a3e7e86c60 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Fri, 8 Mar 2002 05:13:31 +0000 Subject: [PATCH] 0.7.1.34: merged patch: CSR "mostly types" (sbcl-devel 2002-03-07) --- BUGS | 23 ++--------------------- src/code/late-type.lisp | 29 +++++++++++++++++------------ tests/print.impure.lisp | 6 ++++++ tests/type.impure.lisp | 10 ++++++++++ version.lisp-expr | 2 +- 5 files changed, 36 insertions(+), 34 deletions(-) diff --git a/BUGS b/BUGS index 7e1cd47..e2d2e8f 100644 --- a/BUGS +++ b/BUGS @@ -332,16 +332,12 @@ WORKAROUND: 50: type system errors reported by Peter Van Eynde July 25, 2000: - c: (SUBTYPEP '(INTEGER (0) (0)) 'NIL) dies with nested errors. - d: In general, the system doesn't like '(INTEGER (0) (0)) -- it - blows up at the level of SPECIFIER-TYPE with - "Lower bound (0) is greater than upper bound (0)." Probably - SPECIFIER-TYPE should return the NIL type instead. g: The type system [still] isn't all that smart about relationships between hairy types. [The original example from PVE was (SUBTYPEP 'CONS '(NOT ATOM)) => NIL, NIL, which was fixed by CSR in sbcl-0.7.1.28, but there are still - plenty of corner cases out there.] + plenty of corner cases out there: (SUBTYPEP 'ATOM 'LIST) + returns NIL, NIL in sbcl-0.7.1.31.] 51: miscellaneous errors reported by Peter Van Eynde July 25, 2000: @@ -531,18 +527,6 @@ WORKAROUND: it should probably look at the class name, the way that it does for STRUCTURE-OBJECTs. -69: - As reported by Martin Atzmueller on the sbcl-devel list 2000-11-22, - > There remains one issue, that is a bug in SBCL: - > According to my interpretation of the spec, the ":" and "@" modifiers - > should appear _after_ the comma-seperated arguments. - > Well, SBCL (and CMUCL for that matter) accept - > (ASSERT (STRING= (FORMAT NIL "~:8D" 1) " 1")) - > where the correct way (IMHO) should be - > (ASSERT (STRING= (FORMAT NIL "~8:D" 1) " 1")) - Probably SBCL should stop accepting the "~:8D"-style format arguments, - or at least issue a warning. - 70: (probably related to bug #65; maybe related to bug #109) The compiler doesn't like &OPTIONAL arguments in LABELS and FLET @@ -619,9 +603,6 @@ WORKAROUND: it would decrease efficiency more than is probably necessary. Perhaps using some sort of accept/reject method would be better. -84: - (SUBTYPEP '(SATISFIES SOME-UNDEFINED-FUN) NIL)=>NIL,T (should be NIL,NIL) - 85: Internally the compiler sometimes evaluates (sb-kernel:type/= (specifier-type '*) (specifier-type t)) diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 3005a9b..c24af81 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -560,8 +560,7 @@ (eq type1 *empty-type*) (eq type2 *wild-type*)) (values t t)) - ((or (eq type1 *wild-type*) - (eq type2 *empty-type*)) + ((eq type1 *wild-type*) (values nil t)) (t (!invoke-type-method :simple-subtypep :complex-subtypep-arg2 @@ -1445,21 +1444,27 @@ (lb (if (consp l) (1+ (car l)) l)) (h (canonicalized-bound high 'integer)) (hb (if (consp h) (1- (car h)) h))) - (when (and hb lb (< hb lb)) - (error "Lower bound ~S is greater than upper bound ~S." l h)) - (make-numeric-type :class 'integer - :complexp :real - :enumerable (not (null (and l h))) - :low lb - :high hb))) + (if (and hb lb (< hb lb)) + ;; previously we threw an error here: + ;; (error "Lower bound ~S is greater than upper bound ~S." l h)) + ;; but ANSI doesn't say anything about that, so: + (specifier-type 'nil) + (make-numeric-type :class 'integer + :complexp :real + :enumerable (not (null (and l h))) + :low lb + :high hb)))) (defmacro !def-bounded-type (type class format) `(!def-type-translator ,type (&optional (low '*) (high '*)) (let ((lb (canonicalized-bound low ',type)) (hb (canonicalized-bound high ',type))) - (unless (numeric-bound-test* lb hb <= <) - (error "Lower bound ~S is not less than upper bound ~S." low high)) - (make-numeric-type :class ',class :format ',format :low lb :high hb)))) + (if (not (numeric-bound-test* lb hb <= <)) + ;; as above, previously we did + ;; (error "Lower bound ~S is not less than upper bound ~S." low high)) + ;; but it is correct to do + (specifier-type 'nil) + (make-numeric-type :class ',class :format ',format :low lb :high hb))))) (!def-bounded-type rational rational nil) diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index 665eaea..b636c37 100644 --- a/tests/print.impure.lisp +++ b/tests/print.impure.lisp @@ -1,5 +1,7 @@ (in-package :cl-user) +(load "assertoid.lisp") + ;;; We should be able to output X readably (at least when *READ-EVAL*). (defun assert-readable-output (x) (assert (eql x @@ -42,5 +44,9 @@ ;;; bug in sbcl-0.7.1.25, reported by DB sbcl-devel 2002-02-25 (assert (string= "0.5" (format nil "~2D" 0.5))) +;;; we want malformed format strings to cause errors rather than have +;;; some DWIM "functionality". +(assert (raises-error? (format nil "~:2T"))) + ;;; success (quit :unix-status 104) diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp index 19e24e0..4b423bb 100644 --- a/tests/type.impure.lisp +++ b/tests/type.impure.lisp @@ -57,6 +57,11 @@ (assert (type-evidently-= '(integer 0 10) '(or (integer 0 5) (integer 4 10)))) +;;; Bug 50(c,d): numeric types with empty ranges should be NIL +(assert (type-evidently-= 'nil '(integer (0) (0)))) +(assert (type-evidently-= 'nil '(rational (0) (0)))) +(assert (type-evidently-= 'nil '(float (0.0) (0.0)))) + ;;; sbcl-0.6.10 did (UPGRADED-ARRAY-ELEMENT-TYPE 'SOME-UNDEF-TYPE)=>T ;;; and (UPGRADED-COMPLEX-PART-TYPE 'SOME-UNDEF-TYPE)=>T. (assert (raises-error? (upgraded-array-element-type 'some-undef-type))) @@ -131,6 +136,11 @@ #|| (assert-t-t (subtypep '(and zilch integer) 'zilch)) ||# +;;; Bug 84: SB-KERNEL:CSUBTYPEP was a bit enthusiastic at +;;; special-casing calls to subtypep involving *EMPTY-TYPE*, +;;; corresponding to the NIL type-specifier; we were bogusly returning +;;; NIL, T (indicating surety) for the following: +(assert-nil-nil (subtypep '(satisfies some-undefined-fun) 'nil)) ;;;; Douglas Thomas Crosher rewrote the CMU CL type test system to ;;;; allow inline type tests for CONDITIONs and STANDARD-OBJECTs, and diff --git a/version.lisp-expr b/version.lisp-expr index 777e090..770ee4d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1.33" +"0.7.1.34" -- 1.7.10.4