GitLab

at 2022-11-25T15:35:51+00:00

Fix #140:  External format for streams that are not file-streams

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
Address #139:  Add :locale external format

Merge branch 'issue-139-add-alias-local-external-format' into 'master'

Address #139:  Add :locale external format

See merge request cmucl/cmucl!102
Merge branch 'master' into issue-139-filename-encoding-utf8

   (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 ())

 	     ;; 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)

   (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))

 	     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))
     * ~~#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`

 "  calling this so that the correct locale is returned."

 msgstr ""

+#: src/code/unix.lisp

+msgid "Get the codeset from the locale"

+msgstr ""

+
 "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"

 #include <assert.h>

 #include <errno.h>

+#include <langinfo.h>

 #include <locale.h>

 #include <math.h>

 #include <netdb.h>

     /* Return -1 if setlocale failed. */

     return locale ? 0 : -1;

 }

+

+char *

+os_get_locale_codeset()

+{

+    return nl_langinfo(CODESET);

+}
       (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)

Raymond Toy pushed to branch issue-139-filename-encoding-utf8 at cmucl / cmucl

Commits:

8 changed files:

Changes: