Mercurial > hg > xemacs-beta

comparison tests/automated/mule-tests.el @ 438:84b14dcb0985 r21-2-27

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-27
author cvs
date Mon, 13 Aug 2007 11:32:25 +0200
parents 9d177e8d4150
children 8de8e3f6228a
comparison
equal deleted inserted replaced
437:e2a4e8b94b82 438:84b14dcb0985
101 ;; Test aset 101 ;; Test aset
102 (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69)))) 102 (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69))))
103 (aset string 0 (make-char 'latin-iso8859-2 42)) 103 (aset string 0 (make-char 'latin-iso8859-2 42))
104 (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69)))) 104 (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69))))
105 105
106 ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c)
107 (defun charset-char-string (charset)
108 (let (lo hi string n)
109 (if (= (charset-chars charset) 94)
110 (setq lo 33 hi 126)
111 (setq lo 32 hi 127))
112 (if (= (charset-dimension charset) 1)
113 (progn
114 (setq string (make-string (1+ (- hi lo)) ??))
115 (setq n 0)
116 (loop for j from lo to hi do
117 (progn
118 (aset string n (make-char charset j))
119 (incf n)))
120 string)
121 (progn
122 (setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??))
123 (setq n 0)
124 (loop for j from lo to hi do
125 (loop for k from lo to hi do
126 (progn
127 (aset string n (make-char charset j k))
128 (incf n))))
129 string))))
130
131 ;; The following two used to crash xemacs!
132 (Assert (charset-char-string 'japanese-jisx0208))
133 (aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 77))
134
135 (let ((greek-string (charset-char-string 'greek-iso8859-7))
136 (string (make-string (* 96 60) ??)))
137 (loop for j from 0 below (length string) do
138 (aset string j (aref greek-string (mod j 96))))
139 (loop for k in '(0 1 58 59) do
140 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
141
142 (let ((greek-string (charset-char-string 'greek-iso8859-7))
143 (string (make-string (* 96 60) ??)))
144 (loop for j from (1- (length string)) downto 0 do
145 (aset string j (aref greek-string (mod j 96))))
146 (loop for k in '(0 1 58 59) do
147 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
148
149 (let ((ascii-string (charset-char-string 'ascii))
150 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
151 (loop for j from 0 below (length string) do
152 (aset string j (aref ascii-string (mod j 94))))
153 (loop for k in '(0 1 58 59) do
154 (Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string))))
155
156 (let ((ascii-string (charset-char-string 'ascii))
157 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
158 (loop for j from (1- (length string)) downto 0 do
159 (aset string j (aref ascii-string (mod j 94))))
160 (loop for k in '(0 1 58 59) do
161 (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))))
162
106 ) 163 )