GitLab

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.

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

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

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

Commits:

2 changed files:

Changes: