From e7459829bca5bc718778a62617ae5d8d57fb1d2b Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Fri, 25 Nov 2022 15:35:51 +0000
Subject: [PATCH] Fix #140:  External format for streams that are not
 file-streams

---
 src/code/stream.lisp            | 18 +++++++++----
 src/general-info/release-21e.md |  1 +
 tests/issues.lisp               | 47 +++++++++++++++++++++++++++++++++
 3 files changed, 61 insertions(+), 5 deletions(-)

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 487e50a8f..08437d603 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -290,13 +290,21 @@
   (stream-dispatch stream
     ;; simple-stream
     (stream::%stream-external-format stream)
-    ;; lisp-stream
-    (typecase stream
+    ;; lisp-stream.  For unsupported streams, signal a type error.
+    (etypecase stream
       #+unicode
       (fd-stream (fd-stream-external-format stream))
-      (synonym-stream (stream-external-format
-		       (symbol-value (synonym-stream-symbol stream))))
-      (t :default))
+      (broadcast-stream
+       ;; See http://www.lispworks.com/documentation/HyperSpec/Body/t_broadc.htm
+       (let ((components (broadcast-stream-streams stream)))
+	 (if (null components)
+	     :default
+	     (stream-external-format (car (last components))))))
+      (synonym-stream
+       ;; Not defined by CLHS.  What should happen if
+       ;; (synonym-stream-symbol stream) is unbound?
+       (stream-external-format
+	(symbol-value (synonym-stream-symbol stream)))))
     ;; fundamental-stream
     :default))
 
diff --git a/src/general-info/release-21e.md b/src/general-info/release-21e.md
index 516caf277..55ab19552 100644
--- a/src/general-info/release-21e.md
+++ b/src/general-info/release-21e.md
@@ -60,6 +60,7 @@ public domain.
     * ~~#134~~ Handle the case of `(expt complex complex-rational)`
     * ~~#136~~ `ensure-directories-exist` should return the given pathspec
     * #139 `*default-external-format*` defaults to `:utf-8`
+    * ~~#140~~ External format for streams that are not `file-stream`'s
     * ~~#141~~ Disallow locales that are pathnames to a localedef file
     * ~~#142~~ `(random 0)` signals incorrect error
     * ~~#147~~ `stream-line-column` method missing for `fundamental-character-output-stream`
diff --git a/tests/issues.lisp b/tests/issues.lisp
index cf55910a9..1a372b42f 100644
--- a/tests/issues.lisp
+++ b/tests/issues.lisp
@@ -745,6 +745,53 @@
       (assert-equal (map 'list #'char-name string)
 		    (map 'list #'char-name (read-line s))))))
   
+;;; Test stream-external-format for various types of streams.
+
+(define-test issue.140.two-way-stream
+    (:tag :issues)
+  (with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*)
+		      :direction :input
+		      :external-format :utf-8)
+    (with-open-file (out "/tmp/output.tst"
+			 :direction :output
+			 :external-format :utf-8
+			 :if-exists :supersede)
+      (let ((two-way-stream (make-two-way-stream in out)))
+	(assert-error 'type-error
+		      (stream-external-format two-way-stream))))))
+
+;; Test synonym-stream returns the format of the underlying stream.
+(define-test issue.140.synonym-stream
+    (:tag :issues)
+  (with-open-file (s (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*)
+		     :direction :input
+		     :external-format :iso8859-1)
+    (let ((syn (make-synonym-stream '*syn-stream*)))
+      (setf syn s)
+      (assert-equal :iso8859-1 (stream-external-format syn)))))
+
+(define-test issue.140.broadcast-stream
+    (:tag :issues)
+  ;; Create 3 output streams.  The exact external formats aren't
+  ;; really important here as long as they're different for each file
+  ;; so we can tell if we got the right answer.
+  (with-open-file (s1 "/tmp/broad-1"
+		      :direction :output
+		      :if-exists :supersede
+		      :external-format :latin1)
+    (with-open-file (s2 "/tmp/broad-2" 
+			:direction :output
+			:if-exists :supersede
+			:external-format :utf-8)
+      (with-open-file (s3 "/tmp/broad-3" 
+			  :direction :output
+			  :if-exists :supersede
+			  :external-format :utf-16)
+	;; The format must be the value from the last stream.
+	(assert-equal :utf-16
+		      (stream-external-format
+		       (make-broadcast-stream s1 s2 s3)))))))
+
 
 (define-test issue.150
     (:tag :issues)
-- 
GitLab