Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl

Commits: 145aa085 by Raymond Toy at 2022-10-18T17:06:58-07:00 Allow broadcast-stream and two-way-stream for stream-external-format

`stream-external-format` for a `broadcast-stream` is `:default`, according to the CLHS.

For a `two-way-stream`, the CLHS doesn't say, so we'll return the common external format if there is one, or `:default` if they're different.

For a `synonym-stream`, the CLHS also doesn't say, so we'll just return the format of the value of the synonym stream symbol.

Add tests for test different types of streams, except for `broadcast-stream`. The ansi-tests have tests for this.

- - - - -

2 changed files:

- src/code/stream.lisp - tests/issues.lisp

Changes:

===================================== src/code/stream.lisp ===================================== @@ -295,8 +295,22 @@ (etypecase stream #+unicode (fd-stream (fd-stream-external-format stream)) - (synonym-stream (stream-external-format - (symbol-value (synonym-stream-symbol stream))))) + (broadcast-stream + ;; See http://www.lispworks.com/documentation/HyperSpec/Body/t_broadc.htm + :default) + (synonym-stream + ;; What should happen if (synonym-stream-symbol stream) is unbound? + (stream-external-format + (symbol-value (synonym-stream-symbol stream)))) + (two-way-stream + ;; Not defined by CLHS, but useful to return the common format + ;; of the input and output streams when they're the same; + ;; otherwise return :default. + (let ((in-format (stream-external-format (two-way-stream-input-stream stream))) + (out-format (stream-external-format (two-way-stream-output-stream stream)))) + (if (eql in-format out-format) + in-format + :default)))) ;; fundamental-stream :default))

===================================== tests/issues.lisp ===================================== @@ -670,9 +670,42 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps)))))))

-(define-test issue.140 +;;; Test stream-external-format for various types of streams. + +;; Test two-way-stream where both streams have the same external +;; format. +(define-test issue.140.1 + (: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-equal :utf-8 (stream-external-format two-way-stream)))))) + +;; Test two-way-stream where the two streams have the different +;; external formats. +(define-test issue.140.2 (:tag :issues) - (with-output-to-string (out) - (with-input-from-string (in "abc") + (with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*) + :direction :input + :external-format :iso8859-1) + (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)))))) + (assert-equal :default (stream-external-format two-way-stream)))))) + +;; Test synonym-stream returns the format of the underlying stream. +(define-test issue.140.3 + (: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)))))

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/145aa085a805aa7f20ea4558...