From 2c04d155bf8810cda8193c9fd8b7d7392f7f7afc Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Mon, 21 Feb 2005 19:17:39 +0000 Subject: [PATCH] 0.8.19.35: * Fix bug, found by Paul F. Dietz in (CTYPE-OF (COMPLEX )). --- NEWS | 2 ++ src/code/late-type.lisp | 6 +++++- tests/array.pure.lisp | 14 +++++++++----- tests/type.pure.lisp | 6 ++++++ version.lisp-expr | 2 +- 5 files changed, 23 insertions(+), 7 deletions(-) diff --git a/NEWS b/NEWS index 0a9217b..e745572 100644 --- a/NEWS +++ b/NEWS @@ -60,6 +60,8 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19: works more reliably. ** Bit-array operations (BIT-AND and similar) worked incorrectly with one-dimensional arrays with fill pointers. + ** TYPE-OF failed on a complex with an integer realpart and a + RATIO imagpart. changes in sbcl-0.8.19 relative to sbcl-0.8.18: * new port: SBCL now works in native 64-bit mode on x86-64/Linux diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 1dacf88..147656e 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -3110,7 +3110,11 @@ (values :complex (min num imag) (max num imag))) (values :real num num)) (make-numeric-type :class (etypecase num - (integer 'integer) + (integer (if (complexp x) + (if (integerp (imagpart x)) + 'integer + 'rational) + 'integer)) (rational 'rational) (float 'float)) :format (and (floatp num) (float-format-name num)) diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index d3dc6cd..5068878 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -181,10 +181,14 @@ (equal (array-dimension v1 0) (array-dimension v2 0)) (loop for i below (array-dimension v1 0) always (eql (aref v1 i) (aref v2 i)))))) - (let ((v1 (make-array 4 :element-type 'bit :fill-pointer 0 - :initial-contents '(0 0 1 1))) - (v2 (make-array 4 :element-type 'bit :fill-pointer 1 - :initial-contents '(0 0 1 1)))) + (let* ((length 1024) + (v1 (make-array length :element-type 'bit :fill-pointer 0)) + (v2 (make-array length :element-type 'bit :fill-pointer 1))) + (loop for i from 0 below length + for x1 in '#1=(0 0 1 1 . #1#) + and x2 in '#2=(0 1 0 1 . #2#) + do (setf (aref v1 i) x1) + do (setf (aref v2 i) x2)) (loop for (bf lf) in '((bit-and logand) (bit-andc1 logandc1) (bit-andc2 logandc2) @@ -201,7 +205,7 @@ (declare (optimize (speed 3) (safety 0))) (,bf v ,v2))) for r1 = (funcall fun v1) - and r2 = (coerce (loop for i below 4 + and r2 = (coerce (loop for i below length collect (logand 1 (funcall lf (aref v1 i) (aref v2 i)))) 'bit-vector) do (assert (bit-vector-equal r1 r2))))) diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp index f472f24..0ea08e0 100644 --- a/tests/type.pure.lisp +++ b/tests/type.pure.lisp @@ -227,3 +227,9 @@ '(real #.(ash -1 10000) #.(ash 1 10000)))) (assert (subtypep '(real (#.(ash -1 1000)) (#.(ash 1 1000))) '(real #.(ash -1 1000) #.(ash 1 1000)))) + +;;; Bug, found by Paul F. Dietz +(let* ((x (eval #c(-1 1/2))) + (type (type-of x))) + (assert (subtypep type '(complex rational))) + (assert (typep x type))) diff --git a/version.lisp-expr b/version.lisp-expr index 9268c98..5418598 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.19.34" +"0.8.19.35" -- 1.7.10.4