From 2e51cd52ce5479b88d7628139aa03b40f6d08c74 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Thu, 15 Apr 2004 01:34:20 +0000 Subject: [PATCH] More ANSI test fixes: o FILE-STRING-LENGTH can be used on BROADCAST-STREAM's where the result is 1. o Graphic characters are not printed using the character name (hence #\space is printed #\ ) o Make INPUT-STREAM-P and OUTPUT-STREAM-P work correctly on synonym streams. o MAKE-STRING-INPUT-STREAM was not accepting NIL for the optional END argument. o Close string-input streams. (We weren't before.) --- code/fd-stream.lisp | 7 +++++-- code/print.lisp | 6 ++++-- code/stream.lisp | 28 ++++++++++++++++++---------- 3 files changed, 27 insertions(+), 14 deletions(-) diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index 2f37e0d7a..f7dae0603 100644 --- a/code/fd-stream.lisp +++ b/code/fd-stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.76 2004/04/06 08:43:29 emarsden Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.77 2004/04/15 01:34:20 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1690,12 +1690,15 @@ (defun file-string-length (stream object) (declare (type (or string character) object) - (type (or file-stream stream:simple-stream) stream)) + (type (or file-stream broadcast-stream stream:simple-stream) stream)) "Return the delta in Stream's FILE-POSITION that would be caused by writing Object to Stream. Non-trivial only in implementations that support international character sets." (typecase stream (stream:simple-stream (stream::%file-string-length stream object)) + (broadcast-stream + ;; CLHS says we must return 1 in this case + 1) (t (etypecase object (character 1) diff --git a/code/print.lisp b/code/print.lisp index 523a55615..12a0b9e53 100644 --- a/code/print.lisp +++ b/code/print.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.86 2003/08/12 21:33:47 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.87 2004/04/15 01:34:20 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1720,7 +1720,9 @@ (if (or *print-escape* *print-readably*) (let ((name (char-name char))) (write-string "#\\" stream) - (if name + ;; CLHS 22.1.3.2 says graphic characters are not printed using + ;; the character name. + (if (and name (not (graphic-char-p char))) (quote-string name stream) (write-char char stream))) (write-char char stream))) diff --git a/code/stream.lisp b/code/stream.lisp index a7761bc1b..b50855e42 100644 --- a/code/stream.lisp +++ b/code/stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.74 2004/04/14 17:06:35 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.75 2004/04/15 01:34:20 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -213,10 +213,13 @@ ;; simple-stream (stream::%input-stream-p stream) ;; lisp-stream - (and (not (eq (lisp-stream-in stream) #'closed-flame)) - (or (not (eq (lisp-stream-in stream) #'ill-in)) - (not (eq (lisp-stream-bin stream) #'ill-bin)) - (not (eq (lisp-stream-n-bin stream) #'ill-n-bin)))))) + (let ((stream (if (synonym-stream-p stream) + (symbol-value (synonym-stream-symbol stream)) + stream))) + (and (not (eq (lisp-stream-in stream) #'closed-flame)) + (or (not (eq (lisp-stream-in stream) #'ill-in)) + (not (eq (lisp-stream-bin stream) #'ill-bin)) + (not (eq (lisp-stream-n-bin stream) #'ill-n-bin))))))) (defun output-stream-p (stream) "Returns non-nil if the given Stream can perform output operations." @@ -227,9 +230,12 @@ ;; simple-stream (stream::%output-stream-p stream) ;; lisp-stream - (and (not (eq (lisp-stream-in stream) #'closed-flame)) - (or (not (eq (lisp-stream-out stream) #'ill-out)) - (not (eq (lisp-stream-bout stream) #'ill-bout)))))) + (let ((stream (if (synonym-stream-p stream) + (symbol-value (synonym-stream-symbol stream)) + stream))) + (and (not (eq (lisp-stream-in stream) #'closed-flame)) + (or (not (eq (lisp-stream-out stream) #'ill-out)) + (not (eq (lisp-stream-bout stream) #'ill-bout))))))) (defun open-stream-p (stream) "Return true if Stream is not closed." @@ -1458,7 +1464,7 @@ output to Output-stream" (type index start) (type (or index null) end)) (internal-make-string-input-stream (coerce string 'simple-string) - start end)) + start (or end (length string)))) ;;;; String Output Streams: @@ -1534,7 +1540,9 @@ output to Output-stream" (fixnum index count)) (if (char= (schar string index) #\newline) (return count)))) - (:element-type 'base-char))) + (:element-type 'base-char) + (:close + (set-closed-flame stream)))) (defun get-output-stream-string (stream) "Returns a string of all the characters sent to a stream made by -- GitLab