Raymond Toy pushed to branch issue-158-darwin-pathnames at cmucl / cmucl

Commits:

6 changed files:

Changes:

  • src/code/extfmts.lisp
    ... ... @@ -370,8 +370,10 @@
    370 370
     		    #() '())))))
    
    371 371
     
    
    372 372
     (defun load-external-format-aliases ()
    
    373
    +  ;; Set filename encoding to NIL to bypass any encoding; it's not
    
    374
    +  ;; needed to open the aliases file.  NIL means the pathname string is passed as is where only the low 8 bits of the 
    
    373 375
       (let ((*package* (find-package "KEYWORD"))
    
    374
    -	(unix::*filename-encoding* :iso8859-1))
    
    376
    +	(unix::*filename-encoding* :null))
    
    375 377
         (with-open-file (stm "ext-formats:aliases" :if-does-not-exist nil
    
    376 378
     			 :external-format :iso8859-1)
    
    377 379
           (when stm
    
    ... ... @@ -486,11 +488,16 @@
    486 488
           (and (consp name) (find-external-format name))
    
    487 489
           (and (with-standard-io-syntax
    
    488 490
     	     ;; Use standard IO syntax so that changes by the user
    
    489
    -	     ;; don't mess up compiling the external format.
    
    490
    -	     (let ((*package* (find-package "STREAM"))
    
    491
    -		   (lisp::*enable-package-locked-errors* nil)
    
    492
    -		   (s (open (format nil "ext-formats:~(~A~).lisp" name)
    
    493
    -			    :if-does-not-exist nil :external-format :iso8859-1)))
    
    491
    +	     ;; don't mess up compiling the external format, but we
    
    492
    +	     ;; don't need to print readably.  Also, set filename
    
    493
    +	     ;; encoding to NIL because we don't need any special
    
    494
    +	     ;; encoding to open the format files.
    
    495
    +	     (let* ((*print-readably* nil)
    
    496
    +		    (unix::*filename-encoding* :null)
    
    497
    +		    (*package* (find-package "STREAM"))
    
    498
    +		    (lisp::*enable-package-locked-errors* nil)
    
    499
    +		    (s (open (format nil "ext-formats:~(~A~).lisp" name)
    
    500
    +			     :if-does-not-exist nil :external-format :iso8859-1)))
    
    494 501
     	       (when s
    
    495 502
     		 (null (nth-value 1 (ext:compile-from-stream s))))))
    
    496 503
                (gethash name *external-formats*))))
    
    ... ... @@ -1150,7 +1157,7 @@ character and illegal outputs are replaced by a question mark.")
    1150 1157
         (unless (find-external-format filenames)
    
    1151 1158
           (error (intl:gettext "Can't find external-format ~S.") filenames))
    
    1152 1159
         (setq filenames (ef-name (find-external-format filenames)))
    
    1153
    -    (when (and unix::*filename-encoding*
    
    1160
    +    (when (and (not (eq unix::*filename-encoding* :null))
    
    1154 1161
     	       (not (eq unix::*filename-encoding* filenames)))
    
    1155 1162
           (cerror (intl:gettext "Change it anyway.")
    
    1156 1163
     	      (intl:gettext "The external-format for encoding filenames is already set.")))
    

  • src/code/lispinit.lisp
    ... ... @@ -344,7 +344,7 @@
    344 344
       #-gengc (setf unix::*interrupt-pending* nil)
    
    345 345
       (setf *type-system-initialized* nil)
    
    346 346
       (setf *break-on-signals* nil)
    
    347
    -  (setf unix::*filename-encoding* nil)
    
    347
    +  (setf unix::*filename-encoding* :null)
    
    348 348
       (setf *enable-darwin-path-normalization* nil)
    
    349 349
       #+gengc (setf conditions::*handler-clusters* nil)
    
    350 350
       (setq intl::*default-domain* "cmucl")
    

  • src/code/save.lisp
    ... ... @@ -164,7 +164,35 @@
    164 164
     		 *default-external-format*))))
    
    165 165
       (values))
    
    166 166
     
    
    167
    - 
    
    167
    +(defun decode-runtime-strings (locale file-locale)
    
    168
    +  ;; The C runtime can initialize the following strings from the
    
    169
    +  ;; command line or the environment.  We need to decode these into
    
    170
    +  ;; the utf-16 strings that Lisp uses.
    
    171
    +  (setf lisp-command-line-list
    
    172
    +	(mapcar #'(lambda (s)
    
    173
    +		    (stream:string-decode s locale))
    
    174
    +		lisp-command-line-list))
    
    175
    +  (setf lisp-environment-list
    
    176
    +	(mapcar #'(lambda (s)
    
    177
    +		    (stream:string-decode s locale))
    
    178
    +		lisp-environment-list))
    
    179
    +  ;; This needs more work..  *cmucl-lib* could be set from the the envvar
    
    180
    +  ;; "CMUCLLIB" or from the "-lib" command-line option, and thus
    
    181
    +  ;; should use the LOCALE to decode the string.
    
    182
    +  (when *cmucl-lib*
    
    183
    +    (setf *cmucl-lib*
    
    184
    +	  (stream:string-decode *cmucl-lib* file-locale)))
    
    185
    +  ;; This also needs more work since the core path could come from the
    
    186
    +  ;; "-core" command-line option and should thus use LOCALE to decode
    
    187
    +  ;; the string.  It could also come from the "CMUCLCORE" envvar.
    
    188
    +  (setf *cmucl-core-path*
    
    189
    +	(stream:string-decode *cmucl-core-path* file-locale))
    
    190
    +  ;; *unidata-path* defaults to a pathname object, but the user can
    
    191
    +  ;; specify a path, so we need to decode the string path if given.
    
    192
    +  (when (and *unidata-path* (stringp *unidata-path*))
    
    193
    +    (setf *unidata-path*
    
    194
    +	  (stream:string-decode *unidata-path* file-locale))))
    
    195
    +
    
    168 196
     (defun save-lisp (core-file-name &key
    
    169 197
     				 (purify t)
    
    170 198
     				 (root-structures ())
    
    ... ... @@ -278,10 +306,9 @@
    278 306
     	     ;; Load external format aliases now so we can aliases to
    
    279 307
     	     ;; specify the external format.
    
    280 308
     	     (stream::load-external-format-aliases)
    
    281
    -	     ;; Set the locale for lisp
    
    282
    -	     (intl::setlocale)
    
    283 309
     	     ;; Set up :locale format
    
    284 310
     	     (set-up-locale-external-format)
    
    311
    +<<<<<<< HEAD
    
    285 312
     	     ;; Set terminal encodings to :locale
    
    286 313
     	     (set-system-external-format :locale)
    
    287 314
     	     #+darwin
    
    ... ... @@ -295,6 +322,18 @@
    295 322
     	       (lisp::load-decomp)
    
    296 323
     	       (lisp::load-combining)
    
    297 324
     	       (setf *enable-darwin-path-normalization* t))
    
    325
    +=======
    
    326
    +	     ;; Set terminal encodings to :locale and filename encoding to :utf-8.
    
    327
    +	     ;; (This needs more work on Darwin.)
    
    328
    +	     (set-system-external-format :locale :utf-8)
    
    329
    +	     (decode-runtime-strings :locale :utf-8)
    
    330
    +	     ;; Need to reinitialize the environment again because
    
    331
    +	     ;; we've possibly changed the environment variables and
    
    332
    +	     ;; pathnames.
    
    333
    +	     (environment-init)
    
    334
    +	     ;; Set the locale for lisp
    
    335
    +	     (intl::setlocale)
    
    336
    +>>>>>>> master
    
    298 337
     	     (ext::process-command-strings process-command-line)
    
    299 338
     	     (setf *editor-lisp-p* nil)
    
    300 339
     	     (macrolet ((find-switch (name)
    

  • src/code/unix.lisp
    ... ... @@ -25,17 +25,22 @@
    25 25
     ;; it must be set to :iso8859-1 (or left as NIL), making files with
    
    26 26
     ;; non-Latin-1 characters "mojibake", but otherwise they'll be inaccessible.
    
    27 27
     ;; Must be set to NIL initially to enable building Lisp!
    
    28
    -(defvar *filename-encoding* nil)
    
    28
    +(defvar *filename-encoding* :null
    
    29
    +  "The encoding to use for converting a namestring to a string that can
    
    30
    +  be used by the operations system.  It must be a valid
    
    31
    +  external-format name or :NULL.  :NULL means the string
    
    32
    +  is passed as is to the operating system.  The operating system will
    
    33
    +  get the low 8 bits of each UTF-16 code unit of the string.")
    
    29 34
     
    
    30 35
     (eval-when (:compile-toplevel :load-toplevel :execute)
    
    31 36
       (defmacro %name->file (string)
    
    32
    -    `(if *filename-encoding*
    
    33
    -	 (string-encode ,string *filename-encoding*)
    
    34
    -	 ,string))
    
    37
    +    `(if (eql *filename-encoding* :null)
    
    38
    +	 ,string
    
    39
    +	 (string-encode ,string *filename-encoding*)))
    
    35 40
       (defmacro %file->name (string)
    
    36
    -    `(if *filename-encoding*
    
    37
    -	 (string-decode ,string *filename-encoding*)
    
    38
    -	 ,string)))
    
    41
    +    `(if (eql *filename-encoding* :null)
    
    42
    +	 ,string
    
    43
    +	 (string-decode ,string *filename-encoding*))))
    
    39 44
     
    
    40 45
     
    
    41 46
     ;;;; Common machine independent structures.
    

  • src/i18n/locale/cmucl-unix.pot
    ... ... @@ -15,6 +15,15 @@ msgstr ""
    15 15
     "Content-Type: text/plain; charset=UTF-8\n"
    
    16 16
     "Content-Transfer-Encoding: 8bit\n"
    
    17 17
     
    
    18
    +#: src/code/unix.lisp
    
    19
    +msgid ""
    
    20
    +"The encoding to use for converting a namestring to a string that can\n"
    
    21
    +"  be used by the operations system.  It must be a valid\n"
    
    22
    +"  external-format name or :NULL.  :NULL means the string\n"
    
    23
    +"  is passed as is to the operating system.  The operating system will\n"
    
    24
    +"  get the low 8 bits of each UTF-16 code unit of the string."
    
    25
    +msgstr ""
    
    26
    +
    
    18 27
     #: src/code/unix.lisp
    
    19 28
     msgid "Syscall ~A failed: ~A"
    
    20 29
     msgstr ""
    

  • tests/issues.lisp
    ... ... @@ -258,6 +258,13 @@
    258 258
     	(assert-equal (map 'list #'char-code out-string)
    
    259 259
     		      (map 'list #'char-code expected))))))
    
    260 260
     
    
    261
    +(define-test issue.25c-setup
    
    262
    +    (:tag :issues)
    
    263
    +  ;; Get the external format before running the test issue.25c.  See
    
    264
    +  ;; issue #161
    
    265
    +  ;; (https://gitlab.common-lisp.net/cmucl/cmucl/-/issues/161).
    
    266
    +  (assert-true (stream::find-external-format :utf16-be)))
    
    267
    +
    
    261 268
     (define-test issue.25c
    
    262 269
         (:tag :issues)
    
    263 270
       ;; Modified test to verify that each octet read from run-program is
    
    ... ... @@ -409,9 +416,12 @@
    409 416
     ;; running a pipeline with linux, but otherwise enable it.  The
    
    410 417
     ;; pipeline defines the envvar GITLAB_CI so check for that.
    
    411 418
     ;;
    
    419
    +;; This also fails on Darwin CI now.  Let's just disable the test if
    
    420
    +;; running on CI.
    
    421
    +;;
    
    412 422
     ;; It would be better if lisp-unit had a way of marking tests as known
    
    413 423
     ;; failures, but it doesn't.
    
    414
    -#+#.(cl:if (cl:and (ext:featurep :linux) (unix:unix-getenv "GITLAB_CI")) '(or) '(and))
    
    424
    +#+#.(cl:if (cl:and (unix:unix-getenv "GITLAB_CI")) '(or) '(and))
    
    415 425
     (define-test issue.41.1
    
    416 426
         (:tag :issues)
    
    417 427
       (issue-41-tester unix:sigstop))
    
    ... ... @@ -682,10 +692,7 @@
    682 692
       ;; work and not return NIL.
    
    683 693
       (assert-true (file-author "."))
    
    684 694
       (assert-true (file-author "bin/build.sh"))
    
    685
    -  (let ((unix::*filename-encoding* :utf-8))
    
    686
    -    ;; Set filename encoding to utf-8 so that we can encode the
    
    687
    -    ;; filename properly.
    
    688
    -    (assert-true
    
    695
    +  (assert-true
    
    689 696
        (file-author
    
    690 697
         (merge-pathnames 
    
    691 698
          (concatenate 'string
    
    ... ... @@ -696,7 +703,7 @@
    696 703
     		  '(#\Hangul_Syllable_An #\Hangul_Syllable_Nyeong #\Hangul_Syllable_Ha
    
    697 704
     		    #\Hangul_Syllable_Sib #\Hangul_Syllable_Ni #\Hangul_Syllable_Gga)
    
    698 705
     		  ".txt")
    
    699
    -     *test-path*)))))
    
    706
    +     *test-path*))))
    
    700 707
     
    
    701 708
     (define-test issue.139-default-external-format
    
    702 709
         (:tag :issues)