diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 487e50a8f57f5431fbe3e0c9171053b54ecb812e..08437d60362e32fe66e1411bcf2e29e8e860bee9 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 516caf277a0aa09b0c114861df0dd0077fad5373..55ab195521ccfb6f772905b12fdf4d8393dd6983 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 cf55910a95a9a15bc4435f210684d5e233d48ec3..1a372b42fa0bb475d99df07c777c8418a6f1c4c2 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)