X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=tests%2Fautomated%2Fmule-tests.el;h=a89690b0e507646b5fde8d39c8376ac17d4f43e9;hp=6348a51cb8ce9aa35a251155eb036fc1a9bb7325;hb=8b2e8ef2dee7da2f0d4cea712b0fc55902c3cff7;hpb=59eec5f21669e81977b5b1fe9bf717cab49cf7fb diff --git a/tests/automated/mule-tests.el b/tests/automated/mule-tests.el index 6348a51..a89690b 100644 --- a/tests/automated/mule-tests.el +++ b/tests/automated/mule-tests.el @@ -233,7 +233,7 @@ the Assert macro checks for correctness." ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c) ;;--------------------------------------------------------------- (defun charset-char-string (charset) - (let (lo hi string n) + (let (lo hi string n (gc-cons-threshold most-positive-fixnum)) (if (= (charset-chars charset) 94) (setq lo 33 hi 126) (setq lo 32 hi 127)) @@ -245,6 +245,7 @@ the Assert macro checks for correctness." (progn (aset string n (make-char charset j)) (incf n))) + (garbage-collect) string) (progn (setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??)) @@ -254,6 +255,7 @@ the Assert macro checks for correctness." (progn (aset string n (make-char charset j k)) (incf n)))) + (garbage-collect) string)))) ;; The following two used to crash xemacs! @@ -293,13 +295,20 @@ the Assert macro checks for correctness." ;;--------------------------------------------------------------- (let* ((scaron (make-char 'latin-iso8859-2 57)) (latin2-string (make-string 4 scaron)) - (prefix (concat (file-name-as-directory (temp-directory)) latin2-string)) + (prefix (concat (file-name-as-directory + (file-truename (temp-directory))) + latin2-string)) (name1 (make-temp-name prefix)) (name2 (make-temp-name prefix)) (file-name-coding-system 'iso-8859-2)) - ;; This is how you suppress output from `message', called by `write-region' - (flet ((append-message (&rest args) ())) + (Silence-Message (Assert (not (equal name1 name2))) + ;; Kludge to handle Mac OS X which groks only UTF-8. + (cond ((eq system-type 'darwin) + (Check-Error-Message 'file-error "Opening output file" + (write-region (point-min) (point-max) name1)) + (require 'un-define) + (setq file-name-coding-system 'utf-8))) (Assert (not (file-exists-p name1))) (write-region (point-min) (point-max) name1) (Assert (file-exists-p name1)) @@ -310,6 +319,27 @@ the Assert macro checks for correctness." (Assert (equal (file-truename name1) name1))) (ignore-file-errors (delete-file name1) (delete-file name2)))) + ;; Is a non-Latin-1 directory name preserved for call-process? + (when (and + ;; The bug should manifest itself on Windows, but I've no access + ;; to a Windows machine to verify that any test works. + (eq directory-sep-char ?/) + ;; file-name-coding-system on Darwin is _always_ UTF-8--the system + ;; enforces this--which coding system we don't have available in + ;; 21.4, outside of packages. I could jump through lots of hoops to + ;; have the test work anyway, but I'm not really into that right + ;; now. + (not (eq system-type 'darwin))) + (let ((process-coding-system-alist '((".*" . iso-8859-1))) + (file-name-coding-system 'iso-8859-1) + default-directory) + (make-directory (concat (temp-directory) "/\260\354")) + (setq file-name-coding-system 'euc-jp) + (setq default-directory (format "%s/%c/" (temp-directory) + (make-char 'japanese-jisx0208 48 108))) + (Assert (equal (shell-command-to-string "pwd") + (format "%s/\260\354\n" (temp-directory)))) + (delete-directory default-directory))) ;; Add many more file operation tests here...