[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] Throw error if the stream is not a file stream.

[Raymond Toy (@rtoy)]

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/08f76fc37691ab430bb4561f46d47ccfb92cdee8

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/08f76fc37691ab430bb4561f46d47ccfb92cdee8
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/20221017/c62bda51/attachment-0001.html>