[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] 4 commits: Fix #150: add aliases cp949 euckr

[Raymond Toy (@rtoy)]

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


Commits:
402c0c01 by Raymond Toy at 2022-11-02T01:00:20+00:00
Fix #150: add aliases cp949 euckr

- - - - -
d825aa54 by Raymond Toy at 2022-11-02T01:00:20+00:00
Merge branch 'issue-150-add-aliases-cp949-euckr' into 'master'

Fix #150: add aliases cp949 euckr

Closes #150

See merge request cmucl/cmucl!106
- - - - -
23f6f8ef by Raymond Toy at 2022-11-02T11:52:39-07:00
Return :default for external format of a two-way-stream

Per discussion on the merge request, we'll return :default for a
`two-way-stream`.  For unsupported streams, signal an error.

Rename the tests to have more meaningful names.

- - - - -
4d69dda7 by Raymond Toy at 2022-11-02T11:57:23-07:00
Merge branch 'master' into issue-140-stream-element-type-two-way-stream

- - - - -


3 changed files:

- src/code/stream.lisp
- src/pcl/simple-streams/external-formats/aliases
- tests/issues.lisp


Changes:

=====================================
src/code/stream.lisp
=====================================
@@ -290,8 +290,7 @@
   (stream-dispatch stream
     ;; simple-stream
     (stream::%stream-external-format stream)
-    ;; lisp-stream
-    ;; The stream is a file stream; signal an error if it's not.
+    ;; lisp-stream.  For unsupported streams, signal a type error.
     (etypecase stream
       #+unicode
       (fd-stream (fd-stream-external-format stream))
@@ -299,18 +298,14 @@
        ;; See http://www.lispworks.com/documentation/HyperSpec/Body/t_broadc.htm
        :default)
       (synonym-stream
-       ;; What should happen if (synonym-stream-symbol stream) is unbound?
+       ;; Not defined by CLHS.  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))))
+       ;; Not defined by CLHS, but use default for backward
+       ;; compatibility.
+       :default))
     ;; fundamental-stream
     :default))
 


=====================================
src/pcl/simple-streams/external-formats/aliases
=====================================
@@ -223,6 +223,8 @@ windows-cp1252	cp1252
 windows-latin1	cp1252
 ms-ansi		cp1252
 
+euckr		euc-kr
+cp949		euc-kr
 ;; These are not yet implemented
 ;;iso-2022-jp	iso2022-jp
 ;;iso2022jp	iso2022-jp


=====================================
tests/issues.lisp
=====================================
@@ -749,7 +749,7 @@
 
 ;; Test two-way-stream where both streams have the same external
 ;; format.
-(define-test issue.140.1
+(define-test issue.140.two-way-stream-same
     (:tag :issues)
   (with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*)
 		      :direction :input
@@ -759,11 +759,11 @@
 			 :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))))))
+	(assert-equal :default (stream-external-format two-way-stream))))))
 
 ;; Test two-way-stream where the two streams have the different
 ;; external formats.
-(define-test issue.140.2
+(define-test issue.140.two-way-stream-diff
     (:tag :issues)
   (with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*)
 		      :direction :input
@@ -776,7 +776,7 @@
 	(assert-equal :default (stream-external-format two-way-stream))))))
 
 ;; Test synonym-stream returns the format of the underlying stream.
-(define-test issue.140.3
+(define-test issue.140.synonym-stream
     (:tag :issues)
   (with-open-file (s (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*)
 		     :direction :input
@@ -784,3 +784,10 @@
     (let ((syn (make-synonym-stream '*syn-stream*)))
       (setf syn s)
       (assert-equal :iso8859-1 (stream-external-format syn)))))
+
+(define-test issue.150
+    (:tag :issues)
+  (let ((ext:*gc-verbose* nil)
+	(*compile-print* nil))
+    (assert-true (stream::find-external-format :euckr))
+    (assert-true (stream::find-external-format :cp949))))



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4e75e96f5b82f1dfcca6f14354c5f364b6252c31...4d69dda728c54cba0ab7c9c084b8df8169771af0

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4e75e96f5b82f1dfcca6f14354c5f364b6252c31...4d69dda728c54cba0ab7c9c084b8df8169771af0
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/20221102/49a016e3/attachment-0001.html>