0.9.3.45: more ANSI test fixes

* SUBTYPEP-FUNCTION.(1-4) now pass

* READ-BYTE and WRITE-BYTE no longer take stream designators, just
  streams (fixes READ-BYTE.ERROR.5 and WRITE-BYTE.ERROR.4)

* Found when reading COMPLEX types code, and in ansi-tests as
  MISC.580: (typep #c(1 2) '(and ratio (not fixnum))) -> error

Astute log-watchers will note that the version in the commit message
for my last commit was wrong. When I started that tree it was
0.9.3.41, but somebody else stole that number in the meantime. I fixed
version.lisp-expr, but not my own brain. Oops :-)

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index abf2e8d..785749f 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -196,7 +196,7 @@
 (!cold-init-forms (setq *unparse-fun-type-simplify* nil))
 
 (!define-type-method (function :negate) (type)
-  (error "NOT FUNCTION too confusing on ~S" (type-specifier type)))
+  (make-negation-type :type type))
 
 (!define-type-method (function :unparse) (type)
   (if *unparse-fun-type-simplify*
@@ -1739,55 +1739,51 @@
                  (if (csubtypep component-type (specifier-type '(eql 0)))
                      *empty-type*
                      (modified-numeric-type component-type
-                                            :complexp :complex))))
+                                            :complexp :complex)))
+               (do-complex (ctype)
+                 (cond
+                   ((eq ctype *empty-type*) *empty-type*)
+                   ((eq ctype *universal-type*) (not-real))
+                   ((typep ctype 'numeric-type) (complex1 ctype))
+                   ((typep ctype 'union-type)
+                    (apply #'type-union
+                           (mapcar #'do-complex (union-type-types ctype))))
+                   ((typep ctype 'member-type)
+                    (apply #'type-union
+                           (mapcar (lambda (x) (do-complex (ctype-of x)))
+                                   (member-type-members ctype))))
+                   ((and (typep ctype 'intersection-type)
+                         ;; FIXME: This is very much a
+                         ;; not-quite-worst-effort, but we are required to do
+                         ;; something here because of our representation of
+                         ;; RATIO as (AND RATIONAL (NOT INTEGER)): we must
+                         ;; allow users to ask about (COMPLEX RATIO).  This
+                         ;; will of course fail to work right on such types
+                         ;; as (AND INTEGER (SATISFIES ZEROP))...
+                         (let ((numbers (remove-if-not
+                                         #'numeric-type-p
+                                         (intersection-type-types ctype))))
+                           (and (car numbers)
+                                (null (cdr numbers))
+                                (eq (numeric-type-complexp (car numbers)) :real)
+                                (complex1 (car numbers))))))
+                   (t
+                    (multiple-value-bind (subtypep certainly)
+                        (csubtypep ctype (specifier-type 'real))
+                      (if (and (not subtypep) certainly)
+                          (not-real)
+                          ;; ANSI just says that TYPESPEC is any subtype of
+                          ;; type REAL, not necessarily a NUMERIC-TYPE. In
+                          ;; particular, at this point TYPESPEC could legally
+                          ;; be a hairy type like (AND NUMBER (SATISFIES
+                          ;; REALP) (SATISFIES ZEROP)), in which case we fall
+                          ;; through the logic above and end up here,
+                          ;; stumped.
+                          (bug "~@<(known bug #145): The type ~S is too hairy to be ~
+used for a COMPLEX component.~:@>"
+                               typespec)))))))
         (let ((ctype (specifier-type typespec)))
-          (cond
-            ((eq ctype *empty-type*) *empty-type*)
-            ((eq ctype *universal-type*) (not-real))
-            ((typep ctype 'numeric-type) (complex1 ctype))
-            ((typep ctype 'union-type)
-             (apply #'type-union
-                    ;; FIXME: This code could suffer from (admittedly
-                    ;; very obscure) cases of bug 145 e.g. when TYPE
-                    ;; is
-                    ;;   (OR (AND INTEGER (SATISFIES ODDP))
-                    ;;       (AND FLOAT (SATISFIES FOO))
-                    ;; and not even report the problem very well.
-                    (mapcar #'complex1 (union-type-types ctype))))
-            ((typep ctype 'member-type)
-             (apply #'type-union
-                    (mapcar (lambda (x) (complex1 (ctype-of x)))
-                            (member-type-members ctype))))
-            ((and (typep ctype 'intersection-type)
-                  ;; FIXME: This is very much a
-                  ;; not-quite-worst-effort, but we are required to do
-                  ;; something here because of our representation of
-                  ;; RATIO as (AND RATIONAL (NOT INTEGER)): we must
-                  ;; allow users to ask about (COMPLEX RATIO).  This
-                  ;; will of course fail to work right on such types
-                  ;; as (AND INTEGER (SATISFIES ZEROP))...
-                  (let ((numbers (remove-if-not
-                                  #'numeric-type-p
-                                  (intersection-type-types ctype))))
-                    (and (car numbers)
-                         (null (cdr numbers))
-                         (eq (numeric-type-complexp (car numbers)) :real)
-                         (complex1 (car numbers))))))
-            (t
-             (multiple-value-bind (subtypep certainly)
-                 (csubtypep ctype (specifier-type 'real))
-               (if (and (not subtypep) certainly)
-                   (not-real)
-                   ;; ANSI just says that TYPESPEC is any subtype of
-                   ;; type REAL, not necessarily a NUMERIC-TYPE. In
-                   ;; particular, at this point TYPESPEC could legally
-                   ;; be a hairy type like (AND NUMBER (SATISFIES
-                   ;; REALP) (SATISFIES ZEROP)), in which case we fall
-                   ;; through the logic above and end up here,
-                   ;; stumped.
-                   (bug "~@<(known bug #145): The type ~S is too hairy to be ~
-                         used for a COMPLEX component.~:@>"
-                        typespec)))))))))
+          (do-complex ctype)))))
 
 ;;; If X is *, return NIL, otherwise return the bound, which must be a
 ;;; member of TYPE or a one-element list of a member of TYPE.

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 1f43db7..a8a1350 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -371,14 +371,13 @@
       (done-with-fast-read-byte))))
 
 (defun read-byte (stream &optional (eof-error-p t) eof-value)
-  (let ((stream (in-synonym-of stream)))
-    (if (ansi-stream-p stream)
-        (ansi-stream-read-byte stream eof-error-p eof-value nil)
-        ;; must be Gray streams FUNDAMENTAL-STREAM
-        (let ((char (stream-read-byte stream)))
-          (if (eq char :eof)
-              (eof-or-lose stream eof-error-p eof-value)
-              char)))))
+  (if (ansi-stream-p stream)
+      (ansi-stream-read-byte stream eof-error-p eof-value nil)
+      ;; must be Gray streams FUNDAMENTAL-STREAM
+      (let ((char (stream-read-byte stream)))
+        (if (eq char :eof)
+            (eof-or-lose stream eof-error-p eof-value)
+            char))))
 
 ;;; Read NUMBYTES bytes into BUFFER beginning at START, and return the
 ;;; number of bytes read.
@@ -596,8 +595,8 @@
   nil)
 
 (defun write-byte (integer stream)
-  (with-out-stream stream (ansi-stream-bout integer)
-                   (stream-write-byte integer))
+  (with-out-stream/no-synonym stream (ansi-stream-bout integer)
+                              (stream-write-byte integer))
   integer)
 \f
 

diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp
index a970eef..e0ea5af 100644 (file)
--- a/src/code/sysmacs.lisp
+++ b/src/code/sysmacs.lisp
@@ -99,8 +99,8 @@ waits until gc is enabled in this thread."
                        `(,function stream ,@args)))))
          `(funcall (,slot stream) stream ,@args))))
 
-(defmacro with-out-stream (stream (slot &rest args) &optional stream-dispatch)
-  `(let ((stream (out-synonym-of ,stream)))
+(defmacro with-out-stream/no-synonym (stream (slot &rest args) &optional stream-dispatch)
+  `(let ((stream ,stream))
     ,(if stream-dispatch
          `(if (ansi-stream-p stream)
               (funcall (,slot stream) stream ,@args)
@@ -108,6 +108,10 @@ waits until gc is enabled in this thread."
                   `(,(destructuring-bind (function &rest args) stream-dispatch
                                          `(,function stream ,@args)))))
          `(funcall (,slot stream) stream ,@args))))
+
+(defmacro with-out-stream (stream (slot &rest args) &optional stream-dispatch)
+  `(with-out-stream/no-synonym ,stream (,slot ,@args) ,stream-dispatch))
+
 \f
 ;;;; These are hacks to make the reader win.
 

diff --git a/version.lisp-expr b/version.lisp-expr
index ec2c737..95ec3c3 100644 (file)
--- 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.9.3.44"
+"0.9.3.45"