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

Commits: 08f76fc3 by Raymond Toy at 2022-10-17T09:46:45-07:00 Throw error if the stream is not a file stream.

Update test to verify that a type error is thrown.

- - - - -

2 changed files:

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

Changes:

===================================== src/code/stream.lisp ===================================== @@ -291,23 +291,12 @@ ;; simple-stream (stream::%stream-external-format stream) ;; lisp-stream - (typecase stream + ;; The stream is a file stream; signal an error if it's not. + (etypecase stream #+unicode (fd-stream (fd-stream-external-format stream)) (synonym-stream (stream-external-format - (symbol-value (synonym-stream-symbol stream)))) - (two-way-stream - (let ((input-format - (stream-external-format (two-way-stream-input-stream stream))) - (output-format - (stream-external-format (two-way-stream-output-stream stream)))) - ;; If the input and output streams have the same format, we - ;; can return the format. If they differ, it's not clear - ;; what to do, so just return :default. - (if (eql input-format output-format) - input-format - :default))) - (t :default)) + (symbol-value (synonym-stream-symbol stream))))) ;; fundamental-stream :default))

===================================== tests/issues.lisp ===================================== @@ -672,12 +672,7 @@

(define-test issue.140 (:tag :issues) - ;; Make sure *standard-input* is a two-way-stream - (assert-true (typep *standard-input* 'two-way-stream)) - (let ((input-format (stream-external-format - (two-way-stream-input-stream *standard-input*))) - (output-format (stream-external-format - (two-way-stream-output-stream *standard-input*)))) - ;; By default, the input and output formats should be the same. - (assert-eql input-format output-format) - (assert-eql input-format (stream-external-format *standard-input*)))) + (with-output-to-string (out) + (with-input-from-string (in "abc") + (let ((two-way-stream (make-two-way-stream in out))) + (assert-error 'type-error (stream-external-format two-way-stream))))))

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/08f76fc37691ab430bb4561f...