[Git][cmucl/cmucl][master] 2 commits: Fix #140: External format for streams that are not file-streams

[Raymond Toy (@rtoy)]

Raymond Toy pushed to branch master at cmucl / cmucl


Commits:
e7459829 by Raymond Toy at 2022-11-25T15:35:51+00:00
Fix #140:  External format for streams that are not file-streams

- - - - -
88843edc by Raymond Toy at 2022-11-25T15:35:52+00:00
Merge branch 'issue-140-stream-element-type-two-way-stream' into 'master'

Fix #140:  External format for streams that are not file-streams

Closes #140

See merge request cmucl/cmucl!97
- - - - -


3 changed files:

- src/code/stream.lisp
- src/general-info/release-21e.md
- tests/issues.lisp


Changes:

=====================================
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))
 


=====================================
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`


=====================================
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)



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6764053dd9530292197b47ff9b7af22d90735232...88843edcf0a2968c8da4b01248aa83f2a84a5a0e

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6764053dd9530292197b47ff9b7af22d90735232...88843edcf0a2968c8da4b01248aa83f2a84a5a0e
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20221125/8d06a917/attachment-0001.html>