X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tests%2Fautomated%2Fmule-tests.el;h=ab905161df3a80fe98c0eb41b2c5f489eb6cb7d3;hb=c75251b247fce6d200b69e6106bbce2d33b1816d;hp=0e44714aca55583553c7002e837a423f3d5ef6b3;hpb=716cfba952c1dc0d2cf5c968971f3780ba728a89;p=chise%2Fxemacs-chise.git.1

diff --git a/tests/automated/mule-tests.el b/tests/automated/mule-tests.el
index 0e44714..ab90516 100644
--- a/tests/automated/mule-tests.el
+++ b/tests/automated/mule-tests.el
@@ -83,7 +83,9 @@ the Assert macro checks for correctness."
 ;;-----------------------------------------------------------------
 
 (when (featurep 'mule)
+  ;;---------------------------------------------------------------
   ;; Test fillarray
+  ;;---------------------------------------------------------------
   (macrolet
       ((fillarray-test
 	(charset1 charset2)
@@ -104,7 +106,9 @@ the Assert macro checks for correctness."
     (aset string 0 (make-char 'latin-iso8859-2 42))
     (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69))))
 
+  ;;---------------------------------------------------------------
   ;; Test coding system functions
+  ;;---------------------------------------------------------------
 
   ;; Create alias for coding system without subsidiaries
   (Assert (coding-system-p (find-coding-system 'binary)))
@@ -225,9 +229,11 @@ the Assert macro checks for correctness."
   (Assert (not (coding-system-alias-p 'nested-mule-tests-alias)))
   (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos)))
 
+  ;;---------------------------------------------------------------
   ;; 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))
@@ -239,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))) ??))
@@ -248,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!
@@ -282,4 +290,70 @@ the Assert macro checks for correctness."
     (loop for k in '(0 1 58 59) do
       (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))))
 
+  ;;---------------------------------------------------------------
+  ;; Test file-system character conversion (and, en passant, file ops)
+  ;;---------------------------------------------------------------
+  (let* ((scaron (make-char 'latin-iso8859-2 57))
+	 (latin2-string (make-string 4 scaron))
+	 (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) ()))
+      (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))
+      (when (fboundp 'make-symbolic-link)
+	(make-symbolic-link name1 name2)
+	(Assert (file-exists-p name2))
+	(Assert (equal (file-truename name2) name1))
+	(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...
+
+  ;;---------------------------------------------------------------
+  ;; Test Unicode-related functions
+  ;;---------------------------------------------------------------
+  (let* ((scaron (make-char 'latin-iso8859-2 57)))
+    (loop for code in '(#x0000 #x2222 #x4444 #xffff) do
+      (progn
+	(set-ucs-char code scaron)
+	(Assert (eq scaron (ucs-char code)))))
+  
+    (Assert (eq nil (set-ucs-char #x1ffff scaron)))
+    (Check-Error wrong-type-argument (set-ucs-char -10000 scaron)))
+  
   )