Mercurial > hg > xemacs-beta

comparison tests/automated/mule-tests.el @ 2026:ca02e61c9829

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-04-19 06:22:32 by stephent] speed up tests <87oepoxzla.fsf@tleepslib.sk.tsukuba.ac.jp> cater to Darwin <87k70cxzdk.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Mon, 19 Apr 2004 06:22:34 +0000
parents 59e2c5b1e38f
children d1754e7f0cea
comparison
equal deleted inserted replaced
2025:2d4ad7f2d9a8 2026:ca02e61c9829
231 231
232 ;;--------------------------------------------------------------- 232 ;;---------------------------------------------------------------
233 ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c) 233 ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c)
234 ;;--------------------------------------------------------------- 234 ;;---------------------------------------------------------------
235 (defun charset-char-string (charset) 235 (defun charset-char-string (charset)
236 (let (lo hi string n) 236 (let (lo hi string n (gc-cons-threshold most-positive-fixnum))
237 (if (= (charset-chars charset) 94) 237 (if (= (charset-chars charset) 94)
238 (setq lo 33 hi 126) 238 (setq lo 33 hi 126)
239 (setq lo 32 hi 127)) 239 (setq lo 32 hi 127))
240 (if (= (charset-dimension charset) 1) 240 (if (= (charset-dimension charset) 1)
241 (progn 241 (progn
243 (setq n 0) 243 (setq n 0)
244 (loop for j from lo to hi do 244 (loop for j from lo to hi do
245 (progn 245 (progn
246 (aset string n (make-char charset j)) 246 (aset string n (make-char charset j))
247 (incf n))) 247 (incf n)))
248 (garbage-collect)
248 string) 249 string)
249 (progn 250 (progn
250 (setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??)) 251 (setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??))
251 (setq n 0) 252 (setq n 0)
252 (loop for j from lo to hi do 253 (loop for j from lo to hi do
253 (loop for k from lo to hi do 254 (loop for k from lo to hi do
254 (progn 255 (progn
255 (aset string n (make-char charset j k)) 256 (aset string n (make-char charset j k))
256 (incf n)))) 257 (incf n))))
258 (garbage-collect)
257 string)))) 259 string))))
258 260
259 ;; The following two used to crash xemacs! 261 ;; The following two used to crash xemacs!
260 (Assert (charset-char-string 'japanese-jisx0208)) 262 (Assert (charset-char-string 'japanese-jisx0208))
261 (aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 77)) 263 (aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 77))
296 (prefix (concat (file-name-as-directory 298 (prefix (concat (file-name-as-directory
297 (file-truename (temp-directory))) 299 (file-truename (temp-directory)))
298 latin2-string)) 300 latin2-string))
299 (name1 (make-temp-name prefix)) 301 (name1 (make-temp-name prefix))
300 (name2 (make-temp-name prefix)) 302 (name2 (make-temp-name prefix))
301 (file-name-coding-system 'iso-8859-2)) 303 (file-name-coding-system
304 ;; 'iso-8859-X doesn't work on darwin (as of "Panther" 10.3), it
305 ;; seems to know that file-name-coding-system is definitely utf-8
306 (if (string-match "darwin" system-configuration)
307 'utf-8
308 'iso-8859-2))
309 )
302 ;; This is how you suppress output from `message', called by `write-region' 310 ;; This is how you suppress output from `message', called by `write-region'
303 (flet ((append-message (&rest args) ())) 311 (flet ((append-message (&rest args) ()))
304 (Assert (not (equal name1 name2))) 312 (Assert (not (equal name1 name2)))
305 (Assert (not (file-exists-p name1))) 313 (Assert (not (file-exists-p name1)))
306 (write-region (point-min) (point-max) name1) 314 (write-region (point-min) (point-max) name1)