Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
-
e7459829
by Raymond Toy at 2022-11-25T15:35:51+00:00
-
88843edc
by Raymond Toy at 2022-11-25T15:35:52+00:00
3 changed files:
Changes:
| ... | ... | @@ -290,13 +290,21 @@ |
| 290 | 290 | (stream-dispatch stream
|
| 291 | 291 | ;; simple-stream
|
| 292 | 292 | (stream::%stream-external-format stream)
|
| 293 | - ;; lisp-stream
|
|
| 294 | - (typecase stream
|
|
| 293 | + ;; lisp-stream. For unsupported streams, signal a type error.
|
|
| 294 | + (etypecase stream
|
|
| 295 | 295 | #+unicode
|
| 296 | 296 | (fd-stream (fd-stream-external-format stream))
|
| 297 | - (synonym-stream (stream-external-format
|
|
| 298 | - (symbol-value (synonym-stream-symbol stream))))
|
|
| 299 | - (t :default))
|
|
| 297 | + (broadcast-stream
|
|
| 298 | + ;; See http://www.lispworks.com/documentation/HyperSpec/Body/t_broadc.htm
|
|
| 299 | + (let ((components (broadcast-stream-streams stream)))
|
|
| 300 | + (if (null components)
|
|
| 301 | + :default
|
|
| 302 | + (stream-external-format (car (last components))))))
|
|
| 303 | + (synonym-stream
|
|
| 304 | + ;; Not defined by CLHS. What should happen if
|
|
| 305 | + ;; (synonym-stream-symbol stream) is unbound?
|
|
| 306 | + (stream-external-format
|
|
| 307 | + (symbol-value (synonym-stream-symbol stream)))))
|
|
| 300 | 308 | ;; fundamental-stream
|
| 301 | 309 | :default))
|
| 302 | 310 |
| ... | ... | @@ -60,6 +60,7 @@ public domain. |
| 60 | 60 | * ~~#134~~ Handle the case of `(expt complex complex-rational)`
|
| 61 | 61 | * ~~#136~~ `ensure-directories-exist` should return the given pathspec
|
| 62 | 62 | * #139 `*default-external-format*` defaults to `:utf-8`
|
| 63 | + * ~~#140~~ External format for streams that are not `file-stream`'s
|
|
| 63 | 64 | * ~~#141~~ Disallow locales that are pathnames to a localedef file
|
| 64 | 65 | * ~~#142~~ `(random 0)` signals incorrect error
|
| 65 | 66 | * ~~#147~~ `stream-line-column` method missing for `fundamental-character-output-stream`
|
| ... | ... | @@ -745,6 +745,53 @@ |
| 745 | 745 | (assert-equal (map 'list #'char-name string)
|
| 746 | 746 | (map 'list #'char-name (read-line s))))))
|
| 747 | 747 |
|
| 748 | +;;; Test stream-external-format for various types of streams.
|
|
| 749 | + |
|
| 750 | +(define-test issue.140.two-way-stream
|
|
| 751 | + (:tag :issues)
|
|
| 752 | + (with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*)
|
|
| 753 | + :direction :input
|
|
| 754 | + :external-format :utf-8)
|
|
| 755 | + (with-open-file (out "/tmp/output.tst"
|
|
| 756 | + :direction :output
|
|
| 757 | + :external-format :utf-8
|
|
| 758 | + :if-exists :supersede)
|
|
| 759 | + (let ((two-way-stream (make-two-way-stream in out)))
|
|
| 760 | + (assert-error 'type-error
|
|
| 761 | + (stream-external-format two-way-stream))))))
|
|
| 762 | + |
|
| 763 | +;; Test synonym-stream returns the format of the underlying stream.
|
|
| 764 | +(define-test issue.140.synonym-stream
|
|
| 765 | + (:tag :issues)
|
|
| 766 | + (with-open-file (s (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*)
|
|
| 767 | + :direction :input
|
|
| 768 | + :external-format :iso8859-1)
|
|
| 769 | + (let ((syn (make-synonym-stream '*syn-stream*)))
|
|
| 770 | + (setf syn s)
|
|
| 771 | + (assert-equal :iso8859-1 (stream-external-format syn)))))
|
|
| 772 | + |
|
| 773 | +(define-test issue.140.broadcast-stream
|
|
| 774 | + (:tag :issues)
|
|
| 775 | + ;; Create 3 output streams. The exact external formats aren't
|
|
| 776 | + ;; really important here as long as they're different for each file
|
|
| 777 | + ;; so we can tell if we got the right answer.
|
|
| 778 | + (with-open-file (s1 "/tmp/broad-1"
|
|
| 779 | + :direction :output
|
|
| 780 | + :if-exists :supersede
|
|
| 781 | + :external-format :latin1)
|
|
| 782 | + (with-open-file (s2 "/tmp/broad-2"
|
|
| 783 | + :direction :output
|
|
| 784 | + :if-exists :supersede
|
|
| 785 | + :external-format :utf-8)
|
|
| 786 | + (with-open-file (s3 "/tmp/broad-3"
|
|
| 787 | + :direction :output
|
|
| 788 | + :if-exists :supersede
|
|
| 789 | + :external-format :utf-16)
|
|
| 790 | + ;; The format must be the value from the last stream.
|
|
| 791 | + (assert-equal :utf-16
|
|
| 792 | + (stream-external-format
|
|
| 793 | + (make-broadcast-stream s1 s2 s3)))))))
|
|
| 794 | + |
|
| 748 | 795 | |
| 749 | 796 | (define-test issue.150
|
| 750 | 797 | (:tag :issues)
|