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