[Git][cmucl/cmucl][issue-139-filename-encoding-utf8] 5 commits: Fix #140: External format for streams that are not file-streams
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Fri Nov 25 18:16:39 UTC 2022
Raymond Toy pushed to branch issue-139-filename-encoding-utf8 at cmucl / cmucl
Commits:
e7459829 by Raymond Toy at 2022-11-25T15:35:51+00:00
Fix #140: External format for streams that are not file-streams
- - - - -
88843edc by Raymond Toy at 2022-11-25T15:35:52+00:00
Merge branch 'issue-140-stream-element-type-two-way-stream' into 'master'
Fix #140: External format for streams that are not file-streams
Closes #140
See merge request cmucl/cmucl!97
- - - - -
225940e4 by Raymond Toy at 2022-11-25T16:07:57+00:00
Address #139: Add :locale external format
- - - - -
bea34994 by Raymond Toy at 2022-11-25T16:07:57+00:00
Merge branch 'issue-139-add-alias-local-external-format' into 'master'
Address #139: Add :locale external format
See merge request cmucl/cmucl!102
- - - - -
73b09b08 by Raymond Toy at 2022-11-25T10:14:09-08:00
Merge branch 'master' into issue-139-filename-encoding-utf8
- - - - -
8 changed files:
- src/code/save.lisp
- src/code/stream.lisp
- src/code/unix.lisp
- src/general-info/release-21e.md
- src/i18n/locale/cmucl-unix.pot
- src/i18n/locale/cmucl.pot
- src/lisp/os-common.c
- tests/issues.lisp
Changes:
=====================================
src/code/save.lisp
=====================================
@@ -142,6 +142,30 @@
(file c-call:c-string)
(initial-function (alien:unsigned #.vm:word-bits)))
+(defun set-up-locale-external-format ()
+ "Add external format alias for :locale to the format specified by
+ the locale as set by setlocale(3C)."
+ (let ((codeset (unix::unix-get-locale-codeset)))
+ (cond ((zerop (length codeset))
+ ;; Codeset was the empty string, so just set :locale to
+ ;; alias to the default external format.
+ (setf (gethash :locale stream::*external-format-aliases*)
+ *default-external-format*))
+ (t
+ (let ((codeset-format (intern codeset "KEYWORD")))
+ ;; If we know the format, we can set the alias.
+ ;; Otherwise, print a warning and use :iso8859-1 as the
+ ;; alias.
+ (setf (gethash :locale stream::*external-format-aliases*)
+ (if (stream::find-external-format codeset-format nil)
+ codeset-format
+ (progn
+ (warn "Unsupported external format; using :iso8859-1 instead: ~S"
+ codeset-format)
+ :iso8859-1)))))))
+ (values))
+
+
(defun save-lisp (core-file-name &key
(purify t)
(root-structures ())
@@ -252,8 +276,13 @@
;; Set the runtime locale
(unless (zerop (unix::unix-setlocale))
(warn "os_setlocale failed"))
+ ;; Load external format aliases now so we can aliases to
+ ;; specify the external format.
+ (stream::load-external-format-aliases)
;; Set the locale for lisp
(intl::setlocale)
+ ;; Set up :locale format
+ (set-up-locale-external-format)
(ext::process-command-strings process-command-line)
(setf *editor-lisp-p* nil)
(macrolet ((find-switch (name)
=====================================
src/code/stream.lisp
=====================================
@@ -290,13 +290,21 @@
(stream-dispatch stream
;; simple-stream
(stream::%stream-external-format stream)
- ;; lisp-stream
- (typecase stream
+ ;; lisp-stream. For unsupported streams, signal a type error.
+ (etypecase stream
#+unicode
(fd-stream (fd-stream-external-format stream))
- (synonym-stream (stream-external-format
- (symbol-value (synonym-stream-symbol stream))))
- (t :default))
+ (broadcast-stream
+ ;; See http://www.lispworks.com/documentation/HyperSpec/Body/t_broadc.htm
+ (let ((components (broadcast-stream-streams stream)))
+ (if (null components)
+ :default
+ (stream-external-format (car (last components))))))
+ (synonym-stream
+ ;; Not defined by CLHS. What should happen if
+ ;; (synonym-stream-symbol stream) is unbound?
+ (stream-external-format
+ (symbol-value (synonym-stream-symbol stream)))))
;; fundamental-stream
:default))
=====================================
src/code/unix.lisp
=====================================
@@ -2918,3 +2918,10 @@
256)))
(when (zerop result)
(cast buf c-call:c-string)))))
+
+(defun unix-get-locale-codeset ()
+ _N"Get the codeset from the locale"
+ (cast (alien-funcall
+ (extern-alien "os_get_locale_codeset"
+ (function (* char))))
+ c-string))
=====================================
src/general-info/release-21e.md
=====================================
@@ -59,7 +59,8 @@ public domain.
* ~~#132~~ Ansi test `RENAME-FILE.1` no fails
* ~~#134~~ Handle the case of `(expt complex complex-rational)`
* ~~#136~~ `ensure-directories-exist` should return the given pathspec
- * #139 `*default-external-format*` defaults to `:utf-8`
+ * #139 `*default-external-format*` defaults to `:utf-8`; add alias for `:locale` external format
+ * ~~#140~~ External format for streams that are not `file-stream`'s
* ~~#141~~ Disallow locales that are pathnames to a localedef file
* ~~#142~~ `(random 0)` signals incorrect error
* ~~#147~~ `stream-line-column` method missing for `fundamental-character-output-stream`
=====================================
src/i18n/locale/cmucl-unix.pot
=====================================
@@ -1435,3 +1435,7 @@ msgid ""
" calling this so that the correct locale is returned."
msgstr ""
+#: src/code/unix.lisp
+msgid "Get the codeset from the locale"
+msgstr ""
+
=====================================
src/i18n/locale/cmucl.pot
=====================================
@@ -6714,6 +6714,12 @@ msgid ""
"This is true if and only if the lisp was started with the -edit switch."
msgstr ""
+#: src/code/save.lisp
+msgid ""
+"Add external format alias for :locale to the format specified by\n"
+" the locale as set by setlocale(3C)."
+msgstr ""
+
#: src/code/save.lisp
msgid ""
"Saves a CMU Common Lisp core image in the file of the specified name. The\n"
=====================================
src/lisp/os-common.c
=====================================
@@ -7,6 +7,7 @@
#include <assert.h>
#include <errno.h>
+#include <langinfo.h>
#include <locale.h>
#include <math.h>
#include <netdb.h>
@@ -796,3 +797,9 @@ os_get_lc_messages(char *buf, int len)
/* Return -1 if setlocale failed. */
return locale ? 0 : -1;
}
+
+char *
+os_get_locale_codeset()
+{
+ return nl_langinfo(CODESET);
+}
=====================================
tests/issues.lisp
=====================================
@@ -766,6 +766,57 @@
(assert-equal (map 'list #'char-name string)
(map 'list #'char-name (read-line s))))))
+(define-test issue.139-locale-external-format
+ (:tag :issues)
+ ;; Just verify that :locale format exists
+ (assert-true (stream::find-external-format :locale nil)))
+
+;;; Test stream-external-format for various types of streams.
+
+(define-test issue.140.two-way-stream
+ (: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-error 'type-error
+ (stream-external-format two-way-stream))))))
+
+;; Test synonym-stream returns the format of the underlying stream.
+(define-test issue.140.synonym-stream
+ (: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)))))
+
+(define-test issue.140.broadcast-stream
+ (:tag :issues)
+ ;; Create 3 output streams. The exact external formats aren't
+ ;; really important here as long as they're different for each file
+ ;; so we can tell if we got the right answer.
+ (with-open-file (s1 "/tmp/broad-1"
+ :direction :output
+ :if-exists :supersede
+ :external-format :latin1)
+ (with-open-file (s2 "/tmp/broad-2"
+ :direction :output
+ :if-exists :supersede
+ :external-format :utf-8)
+ (with-open-file (s3 "/tmp/broad-3"
+ :direction :output
+ :if-exists :supersede
+ :external-format :utf-16)
+ ;; The format must be the value from the last stream.
+ (assert-equal :utf-16
+ (stream-external-format
+ (make-broadcast-stream s1 s2 s3)))))))
(define-test issue.150
(:tag :issues)
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8149dbd2682f2e37a6103b6150c3cef4c50dc88c...73b09b0889065af3ab506963a1a2b4934020c604
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8149dbd2682f2e37a6103b6150c3cef4c50dc88c...73b09b0889065af3ab506963a1a2b4934020c604
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/20221125/405c6fb9/attachment-0001.html>
More information about the cmucl-cvs
mailing list