comparison tests/automated/mule-tests.el @ 5136:0f66906b6e37

Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-03-12 Ben Wing <ben@xemacs.org> * test-harness.el (test-harness-from-buffer): Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). Get rid of `Assert-equalp' and friends, `Assert-test', and `Assert-test-not'. Instead, make `Assert' smart enough to do the equivalent functionality when an expression like (Assert (equalp ...)) is seen. tests/ChangeLog addition: 2010-03-12 Ben Wing <ben@xemacs.org> * automated/base64-tests.el (bt-base64-encode-string): * automated/base64-tests.el (bt-base64-decode-string): * automated/base64-tests.el (for): * automated/byte-compiler-tests.el: * automated/byte-compiler-tests.el (before-and-after-compile-equal): * automated/case-tests.el (downcase-string): * automated/case-tests.el (uni-mappings): * automated/ccl-tests.el (ccl-test-normal-expr): * automated/ccl-tests.el (ccl-test-map-instructions): * automated/ccl-tests.el (ccl-test-suites): * automated/database-tests.el (delete-database-files): * automated/extent-tests.el (let): * automated/extent-tests.el (insert): * automated/extent-tests.el (props): * automated/file-tests.el: * automated/file-tests.el (for): * automated/hash-table-tests.el (test): * automated/hash-table-tests.el (for): * automated/hash-table-tests.el (ht): * automated/hash-table-tests.el (iterations): * automated/hash-table-tests.el (h1): * automated/hash-table-tests.el (equal): * automated/hash-table-tests.el (=): * automated/lisp-tests.el: * automated/lisp-tests.el (eq): * automated/lisp-tests.el (test-setq): * automated/lisp-tests.el (my-vector): * automated/lisp-tests.el (x): * automated/lisp-tests.el (equal): * automated/lisp-tests.el (y): * automated/lisp-tests.el (featurep): * automated/lisp-tests.el (=): * automated/lisp-tests.el (six): * automated/lisp-tests.el (three): * automated/lisp-tests.el (one): * automated/lisp-tests.el (two): * automated/lisp-tests.el (five): * automated/lisp-tests.el (test1): * automated/lisp-tests.el (division-test): * automated/lisp-tests.el (for): * automated/lisp-tests.el (check-function-argcounts): * automated/lisp-tests.el (z): * automated/lisp-tests.el (eql): * automated/lisp-tests.el (test-harness-risk-infloops): * automated/lisp-tests.el (erase-buffer): * automated/lisp-tests.el (sym): * automated/lisp-tests.el (new-char): * automated/lisp-tests.el (new-load-file-name): * automated/lisp-tests.el (cl-floor): * automated/lisp-tests.el (foo): * automated/md5-tests.el (lambda): * automated/md5-tests.el (large-string): * automated/md5-tests.el (mapcar): * automated/md5-tests.el (insert): * automated/mule-tests.el: * automated/mule-tests.el (test-chars): * automated/mule-tests.el (existing-file-name): * automated/mule-tests.el (featurep): * automated/query-coding-tests.el (featurep): * automated/regexp-tests.el: * automated/regexp-tests.el (insert): * automated/regexp-tests.el (Assert): * automated/regexp-tests.el (=): * automated/regexp-tests.el (featurep): * automated/regexp-tests.el (text): * automated/regexp-tests.el (text1): * automated/regexp-tests.el ("aáa"): * automated/regexp-tests.el (eql): * automated/search-tests.el (insert): * automated/search-tests.el (featurep): * automated/search-tests.el (let): * automated/search-tests.el (boundp): * automated/symbol-tests.el: * automated/symbol-tests.el (name): * automated/symbol-tests.el (check-weak-list-unique): * automated/symbol-tests.el (string): * automated/symbol-tests.el (list): * automated/symbol-tests.el (foo): * automated/symbol-tests.el (eq): * automated/symbol-tests.el (fresh-keyword-name): * automated/symbol-tests.el (print-gensym): * automated/symbol-tests.el (mysym): * automated/syntax-tests.el (test-forward-word): * automated/syntax-tests.el (test-backward-word): * automated/syntax-tests.el (test-syntax-table): * automated/syntax-tests.el (with-syntax-table): * automated/syntax-tests.el (Skip-Test-Unless): * automated/syntax-tests.el (with): * automated/tag-tests.el (testfile): * automated/weak-tests.el (w): * automated/weak-tests.el (p): * automated/weak-tests.el (a): Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). Get rid of `Assert-equalp' and friends, `Assert-test', and `Assert-test-not'. Instead, make `Assert' smart enough to do the equivalent functionality when an expression like (Assert (equalp ...)) is seen.
author Ben Wing <ben@xemacs.org>
date Fri, 12 Mar 2010 18:27:51 -0600
parents ae4ddcdf30c0
children c096d8051f89 308d34e9f07d
comparison
equal deleted inserted replaced
5113:b2dcf6a6d8ab 5136:0f66906b6e37
1 ;; Copyright (C) 1999 Free Software Foundation, Inc. 1 ;; Copyright (C) 1999 Free Software Foundation, Inc.
2 ;; Copyright (C) 2010 Ben Wing.
2 3
3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org> 4 ;; Author: Hrvoje Niksic <hniksic@xemacs.org>
4 ;; Maintainers: Hrvoje Niksic <hniksic@xemacs.org>, 5 ;; Maintainers: Hrvoje Niksic <hniksic@xemacs.org>,
5 ;; Martin Buchholz <martin@xemacs.org> 6 ;; Martin Buchholz <martin@xemacs.org>
6 ;; Created: 1999 7 ;; Created: 1999
63 (if for-test-harness 64 (if for-test-harness
64 ;; For use with test-harness, use Assert and a temporary 65 ;; For use with test-harness, use Assert and a temporary
65 ;; buffer. 66 ;; buffer.
66 (with-temp-buffer 67 (with-temp-buffer
67 (insert string) 68 (insert string)
68 (Assert-equal (buffer-string) string)) 69 (Assert (equal (buffer-string) string)))
69 ;; For use without test harness: use a normal buffer, so that 70 ;; For use without test harness: use a normal buffer, so that
70 ;; you can also test whether redisplay works. 71 ;; you can also test whether redisplay works.
71 (switch-to-buffer (get-buffer-create "test")) 72 (switch-to-buffer (get-buffer-create "test"))
72 (erase-buffer) 73 (erase-buffer)
73 (buffer-disable-undo) 74 (buffer-disable-undo)
150 (coding-system-type buffer-file-coding-system)))) 151 (coding-system-type buffer-file-coding-system))))
151 (kill-buffer nil) 152 (kill-buffer nil)
152 (dolist (coding-system '(utf-8 windows-1251 macintosh big5)) 153 (dolist (coding-system '(utf-8 windows-1251 macintosh big5))
153 (when (find-coding-system coding-system) 154 (when (find-coding-system coding-system)
154 (find-file existing-file-name coding-system) 155 (find-file existing-file-name coding-system)
155 (Assert-eq (find-coding-system coding-system) 156 (Assert (eq (find-coding-system coding-system)
156 buffer-file-coding-system) 157 buffer-file-coding-system))
157 (kill-buffer nil) 158 (kill-buffer nil)
158 (find-file nonexistent-file-name coding-system) 159 (find-file nonexistent-file-name coding-system)
159 (Assert-eq (find-coding-system coding-system) 160 (Assert (eq (find-coding-system coding-system)
160 buffer-file-coding-system) 161 buffer-file-coding-system))
161 (set-buffer-modified-p nil) 162 (set-buffer-modified-p nil)
162 (kill-buffer nil))) 163 (kill-buffer nil)))
163 (delete-file existing-file-name)) 164 (delete-file existing-file-name))
164 165
165 ;;----------------------------------------------------------------- 166 ;;-----------------------------------------------------------------
175 (charset1 charset2) 176 (charset1 charset2)
176 (let ((char1 (make-char charset1 69)) 177 (let ((char1 (make-char charset1 69))
177 (char2 (make-char charset2 69))) 178 (char2 (make-char charset2 69)))
178 `(let ((string (make-string 1000 ,char1))) 179 `(let ((string (make-string 1000 ,char1)))
179 (fillarray string ,char2) 180 (fillarray string ,char2)
180 (Assert-eq (aref string 0) ,char2) 181 (Assert (eq (aref string 0) ,char2))
181 (Assert-eq (aref string (1- (length string))) ,char2) 182 (Assert (eq (aref string (1- (length string))) ,char2))
182 (Assert-eq (length string) 1000))))) 183 (Assert (eq (length string) 1000))))))
183 (fillarray-test ascii latin-iso8859-1) 184 (fillarray-test ascii latin-iso8859-1)
184 (fillarray-test ascii latin-iso8859-2) 185 (fillarray-test ascii latin-iso8859-2)
185 (fillarray-test latin-iso8859-1 ascii) 186 (fillarray-test latin-iso8859-1 ascii)
186 (fillarray-test latin-iso8859-2 ascii)) 187 (fillarray-test latin-iso8859-2 ascii))
187 188
188 ;; Test aset 189 ;; Test aset
189 (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69)))) 190 (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69))))
190 (aset string 0 (make-char 'latin-iso8859-2 42)) 191 (aset string 0 (make-char 'latin-iso8859-2 42))
191 (Assert-eq (aref string 1) (make-char 'latin-iso8859-2 69))) 192 (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69))))
192 193
193 ;;--------------------------------------------------------------- 194 ;;---------------------------------------------------------------
194 ;; Test coding system functions 195 ;; Test coding system functions
195 ;;--------------------------------------------------------------- 196 ;;---------------------------------------------------------------
196 197
208 (coding-system-aliasee 'binary)) 209 (coding-system-aliasee 'binary))
209 210
210 (define-coding-system-alias 'mule-tests-alias 'binary) 211 (define-coding-system-alias 'mule-tests-alias 'binary)
211 (Assert (coding-system-alias-p 'mule-tests-alias)) 212 (Assert (coding-system-alias-p 'mule-tests-alias))
212 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) 213 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
213 (Assert-eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)) 214 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)))
214 (Assert-eq 'binary (coding-system-aliasee 'mule-tests-alias)) 215 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias)))
215 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) 216 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
216 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) 217 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos)))
217 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) 218 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac)))
218 219
219 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary)) 220 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary))
220 (Assert (coding-system-alias-p 'mule-tests-alias)) 221 (Assert (coding-system-alias-p 'mule-tests-alias))
221 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) 222 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
222 (Assert-eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)) 223 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)))
223 (Assert-eq 'binary (coding-system-aliasee 'mule-tests-alias)) 224 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias)))
224 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) 225 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
225 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) 226 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos)))
226 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) 227 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac)))
227 228
228 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) 229 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias)
229 (Assert (coding-system-alias-p 'nested-mule-tests-alias)) 230 (Assert (coding-system-alias-p 'nested-mule-tests-alias))
230 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) 231 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias)))
231 (Assert-eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias)) 232 (Assert (eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias)))
232 (Assert-eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias) 233 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias))
233 (Assert-eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)) 234 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)))
234 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix))) 235 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix)))
235 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) 236 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos)))
236 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac))) 237 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac)))
237 238
238 (Check-Error-Message 239 (Check-Error-Message
264 265
265 ;; Create alias for coding system with subsidiaries 266 ;; Create alias for coding system with subsidiaries
266 (define-coding-system-alias 'mule-tests-alias 'iso-8859-7) 267 (define-coding-system-alias 'mule-tests-alias 'iso-8859-7)
267 (Assert (coding-system-alias-p 'mule-tests-alias)) 268 (Assert (coding-system-alias-p 'mule-tests-alias))
268 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) 269 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
269 (Assert-eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)) 270 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)))
270 (Assert-eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)) 271 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)))
271 (Assert (coding-system-alias-p 'mule-tests-alias-unix)) 272 (Assert (coding-system-alias-p 'mule-tests-alias-unix))
272 (Assert (coding-system-alias-p 'mule-tests-alias-dos)) 273 (Assert (coding-system-alias-p 'mule-tests-alias-dos))
273 (Assert (coding-system-alias-p 'mule-tests-alias-mac)) 274 (Assert (coding-system-alias-p 'mule-tests-alias-mac))
274 275
275 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'iso-8859-7)) 276 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'iso-8859-7))
276 (Assert (coding-system-alias-p 'mule-tests-alias)) 277 (Assert (coding-system-alias-p 'mule-tests-alias))
277 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) 278 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
278 (Assert-eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)) 279 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)))
279 (Assert-eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)) 280 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)))
280 (Assert (coding-system-alias-p 'mule-tests-alias-unix)) 281 (Assert (coding-system-alias-p 'mule-tests-alias-unix))
281 (Assert (coding-system-alias-p 'mule-tests-alias-dos)) 282 (Assert (coding-system-alias-p 'mule-tests-alias-dos))
282 (Assert (coding-system-alias-p 'mule-tests-alias-mac)) 283 (Assert (coding-system-alias-p 'mule-tests-alias-mac))
283 (Assert-eq (find-coding-system 'mule-tests-alias-mac) 284 (Assert (eq (find-coding-system 'mule-tests-alias-mac)
284 (find-coding-system 'iso-8859-7-mac)) 285 (find-coding-system 'iso-8859-7-mac)))
285 286
286 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) 287 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias)
287 (Assert (coding-system-alias-p 'nested-mule-tests-alias)) 288 (Assert (coding-system-alias-p 'nested-mule-tests-alias))
288 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) 289 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias)))
289 (Assert-eq (get-coding-system 'iso-8859-7) 290 (Assert (eq (get-coding-system 'iso-8859-7)
290 (get-coding-system 'nested-mule-tests-alias)) 291 (get-coding-system 'nested-mule-tests-alias)))
291 (Assert-eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias) 292 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias))
292 (Assert-eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)) 293 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)))
293 (Assert (coding-system-alias-p 'nested-mule-tests-alias-unix)) 294 (Assert (coding-system-alias-p 'nested-mule-tests-alias-unix))
294 (Assert (coding-system-alias-p 'nested-mule-tests-alias-dos)) 295 (Assert (coding-system-alias-p 'nested-mule-tests-alias-dos))
295 (Assert (coding-system-alias-p 'nested-mule-tests-alias-mac)) 296 (Assert (coding-system-alias-p 'nested-mule-tests-alias-mac))
296 (Assert-eq (find-coding-system 'nested-mule-tests-alias-unix) 297 (Assert (eq (find-coding-system 'nested-mule-tests-alias-unix)
297 (find-coding-system 'iso-8859-7-unix)) 298 (find-coding-system 'iso-8859-7-unix)))
298 299
299 (Check-Error-Message 300 (Check-Error-Message
300 error "Attempt to create a coding system alias loop" 301 error "Attempt to create a coding system alias loop"
301 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias)) 302 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias))
302 (Check-Error-Message 303 (Check-Error-Message
349 (let ((greek-string (charset-char-string 'greek-iso8859-7)) 350 (let ((greek-string (charset-char-string 'greek-iso8859-7))
350 (string (make-string (* 96 60) ??))) 351 (string (make-string (* 96 60) ??)))
351 (loop for j from 0 below (length string) do 352 (loop for j from 0 below (length string) do
352 (aset string j (aref greek-string (mod j 96)))) 353 (aset string j (aref greek-string (mod j 96))))
353 (loop for k in '(0 1 58 59) do 354 (loop for k in '(0 1 58 59) do
354 (Assert-equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))) 355 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
355 356
356 (let ((greek-string (charset-char-string 'greek-iso8859-7)) 357 (let ((greek-string (charset-char-string 'greek-iso8859-7))
357 (string (make-string (* 96 60) ??))) 358 (string (make-string (* 96 60) ??)))
358 (loop for j from (1- (length string)) downto 0 do 359 (loop for j from (1- (length string)) downto 0 do
359 (aset string j (aref greek-string (mod j 96)))) 360 (aset string j (aref greek-string (mod j 96))))
360 (loop for k in '(0 1 58 59) do 361 (loop for k in '(0 1 58 59) do
361 (Assert-equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))) 362 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
362 363
363 (let ((ascii-string (charset-char-string 'ascii)) 364 (let ((ascii-string (charset-char-string 'ascii))
364 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) 365 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
365 (loop for j from 0 below (length string) do 366 (loop for j from 0 below (length string) do
366 (aset string j (aref ascii-string (mod j 94)))) 367 (aset string j (aref ascii-string (mod j 94))))
367 (loop for k in '(0 1 58 59) do 368 (loop for k in '(0 1 58 59) do
368 (Assert-equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string))) 369 (Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string))))
369 370
370 (let ((ascii-string (charset-char-string 'ascii)) 371 (let ((ascii-string (charset-char-string 'ascii))
371 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) 372 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
372 (loop for j from (1- (length string)) downto 0 do 373 (loop for j from (1- (length string)) downto 0 do
373 (aset string j (aref ascii-string (mod j 94)))) 374 (aset string j (aref ascii-string (mod j 94))))
374 (loop for k in '(0 1 58 59) do 375 (loop for k in '(0 1 58 59) do
375 (Assert-equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))) 376 (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))))
376 377
377 ;;--------------------------------------------------------------- 378 ;;---------------------------------------------------------------
378 ;; Test string character conversion 379 ;; Test string character conversion
379 ;;--------------------------------------------------------------- 380 ;;---------------------------------------------------------------
380 381
436 ;; name3 already exists and OK-IF-ALREADY-EXISTS was not specified. 437 ;; name3 already exists and OK-IF-ALREADY-EXISTS was not specified.
437 (setq working-symlinks t))) 438 (setq working-symlinks t)))
438 (when working-symlinks 439 (when working-symlinks
439 (make-symbolic-link name1 name2) 440 (make-symbolic-link name1 name2)
440 (Assert (file-exists-p name2)) 441 (Assert (file-exists-p name2))
441 (Assert-equal (file-truename name2) name1) 442 (Assert (equal (file-truename name2) name1))
442 (Assert-equal (file-truename name1) name1)) 443 (Assert (equal (file-truename name1) name1)))
443 (ignore-file-errors (delete-file name1)) 444 (ignore-file-errors (delete-file name1))
444 (ignore-file-errors (delete-file name2)) 445 (ignore-file-errors (delete-file name2))
445 (ignore-file-errors (delete-file name3))) 446 (ignore-file-errors (delete-file name3)))
446 447
447 ;; Add many more file operation tests here... 448 ;; Add many more file operation tests here...
455 for code in '(#x0100 #x2222 #x4444 #xffff) 456 for code in '(#x0100 #x2222 #x4444 #xffff)
456 with initial-unicode = (char-to-unicode scaron) 457 with initial-unicode = (char-to-unicode scaron)
457 do 458 do
458 (progn 459 (progn
459 (set-unicode-conversion scaron code) 460 (set-unicode-conversion scaron code)
460 (Assert-eq code (char-to-unicode scaron)) 461 (Assert (eq code (char-to-unicode scaron)))
461 (Assert-eq scaron (unicode-to-char code '(latin-iso8859-2)))) 462 (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2)))))
462 finally (set-unicode-conversion scaron initial-unicode)) 463 finally (set-unicode-conversion scaron initial-unicode))
463 (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000))) 464 (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000)))
464 465
465 (dolist (utf-8-char 466 (dolist (utf-8-char
466 '("\xc6\x92" ;; U+0192 LATIN SMALL LETTER F WITH HOOK 467 '("\xc6\x92" ;; U+0192 LATIN SMALL LETTER F WITH HOOK
471 "\xf0\xaf\xa8\x88" ;; U+2FA08 CJK COMPATIBILITY FOR U+4BCE 472 "\xf0\xaf\xa8\x88" ;; U+2FA08 CJK COMPATIBILITY FOR U+4BCE
472 "\xf4\x8f\xbf\xbd")) ;; U+10FFFD <Plane 16 Private Use, Last> 473 "\xf4\x8f\xbf\xbd")) ;; U+10FFFD <Plane 16 Private Use, Last>
473 (let* ((xemacs-character (car (append 474 (let* ((xemacs-character (car (append
474 (decode-coding-string utf-8-char 'utf-8) 475 (decode-coding-string utf-8-char 'utf-8)
475 nil))) 476 nil)))
476 (xemacs-charset (char-charset xemacs-character))) 477 (xemacs-charset (car (split-char xemacs-character))))
477 478
478 ;; Trivial test of the UTF-8 support of the escape-quoted character set. 479 ;; Trivial test of the UTF-8 support of the escape-quoted character set.
479 (Assert-equal (decode-coding-string utf-8-char 'utf-8) 480 (Assert (equal (decode-coding-string utf-8-char 'utf-8)
480 (decode-coding-string (concat "\033%G" utf-8-char) 481 (decode-coding-string (concat "\033%G" utf-8-char)
481 'escape-quoted)) 482 'escape-quoted)))
482 483
483 ;; Check that the reverse mapping holds. 484 ;; Check that the reverse mapping holds.
484 (Assert-equal (unicode-code-point-to-utf-8-string 485 (Assert (equal (unicode-code-point-to-utf-8-string
485 (encode-char xemacs-character 'ucs)) 486 (encode-char xemacs-character 'ucs))
486 utf-8-char) 487 utf-8-char))
487 488
488 ;; Check that, if this character has been JIT-allocated, it is encoded 489 ;; Check that, if this character has been JIT-allocated, it is encoded
489 ;; in escape-quoted using the corresponding UTF-8 escape. 490 ;; in escape-quoted using the corresponding UTF-8 escape.
490 (when (charset-property xemacs-charset 'encode-as-utf-8) 491 (when (charset-property xemacs-charset 'encode-as-utf-8)
491 (Assert-equal (concat "\033%G" utf-8-char) 492 (Assert (equal (concat "\033%G" utf-8-char)
492 (encode-coding-string xemacs-character 'escape-quoted)) 493 (encode-coding-string xemacs-character 'escape-quoted)))
493 (Assert-equal (concat "\033%G" utf-8-char) 494 (Assert (equal (concat "\033%G" utf-8-char)
494 (encode-coding-string xemacs-character 'ctext))))) 495 (encode-coding-string xemacs-character 'ctext))))))
495 496
496 (loop 497 (loop
497 for (code-point utf-16-big-endian utf-16-little-endian) 498 for (code-point utf-16-big-endian utf-16-little-endian)
498 in '((#x10000 "\xd8\x00\xdc\x00" "\x00\xd8\x00\xdc") 499 in '((#x10000 "\xd8\x00\xdc\x00" "\x00\xd8\x00\xdc")
499 (#x10FFFD "\xdb\xff\xdf\xfd" "\xff\xdb\xfd\xdf")) 500 (#x10FFFD "\xdb\xff\xdf\xfd" "\xff\xdb\xfd\xdf"))
500 do 501 do
501 (Assert-equal (encode-coding-string 502 (Assert (equal (encode-coding-string
502 (decode-char 'ucs code-point) 'utf-16) 503 (decode-char 'ucs code-point) 'utf-16)
503 utf-16-big-endian) 504 utf-16-big-endian))
504 (Assert-equal (encode-coding-string 505 (Assert (equal (encode-coding-string
505 (decode-char 'ucs code-point) 'utf-16-le) 506 (decode-char 'ucs code-point) 'utf-16-le)
506 utf-16-little-endian)) 507 utf-16-little-endian)))
507 508
508 509
509 ;;--------------------------------------------------------------- 510 ;;---------------------------------------------------------------
510 ;; Regression test for a couple of CCL-related bugs. 511 ;; Regression test for a couple of CCL-related bugs.
511 ;;--------------------------------------------------------------- 512 ;;---------------------------------------------------------------
518 (write-multibyte-character r0 r1) 519 (write-multibyte-character r0 r1)
519 (r1 = 31) 520 (r1 = 31)
520 (write-multibyte-character r0 r1))) 521 (write-multibyte-character r0 r1)))
521 "CCL program that writes two control-1 multibyte characters.") 522 "CCL program that writes two control-1 multibyte characters.")
522 523
523 (Assert-equal 524 (Assert (equal
524 (ccl-execute-on-string 'ccl-write-two-control-1-chars 525 (ccl-execute-on-string 'ccl-write-two-control-1-chars
525 ccl-vector "") 526 ccl-vector "")
526 (format "%c%c" (make-char 'control-1 0) 527 (format "%c%c" (make-char 'control-1 0)
527 (make-char 'control-1 31))) 528 (make-char 'control-1 31))))
528 529
529 (define-ccl-program ccl-unicode-two-control-1-chars 530 (define-ccl-program ccl-unicode-two-control-1-chars
530 `(1 531 `(1
531 ((r0 = ,(charset-id 'control-1)) 532 ((r0 = ,(charset-id 'control-1))
532 (r1 = 31) 533 (r1 = 31)
560 (when (and (eq 'fixed-width (coding-system-type coding-system)) 561 (when (and (eq 'fixed-width (coding-system-type coding-system))
561 ;; Don't check the coding systems with odd line endings 562 ;; Don't check the coding systems with odd line endings
562 ;; (maybe we should): 563 ;; (maybe we should):
563 (eq 'lf (coding-system-eol-type coding-system))) 564 (eq 'lf (coding-system-eol-type coding-system)))
564 ;; These coding systems are round-trip compatible with themselves. 565 ;; These coding systems are round-trip compatible with themselves.
565 (Assert-equal (encode-coding-string 566 (Assert (equal (encode-coding-string
566 (decode-coding-string all-possible-octets 567 (decode-coding-string all-possible-octets
567 coding-system) 568 coding-system)
568 coding-system) 569 coding-system)
569 all-possible-octets 570 all-possible-octets)
570 (format "checking %s is transparent" coding-system)))) 571 (format "checking %s is transparent" coding-system))))
571 572
572 ;;--------------------------------------------------------------- 573 ;;---------------------------------------------------------------
573 ;; Test charset-in-* functions 574 ;; Test charset-in-* functions
574 ;;--------------------------------------------------------------- 575 ;;---------------------------------------------------------------
578 '(arabic-iso8859-6 ascii chinese-big5-1 chinese-gb2312 579 '(arabic-iso8859-6 ascii chinese-big5-1 chinese-gb2312
579 cyrillic-iso8859-5 ethiopic greek-iso8859-7 580 cyrillic-iso8859-5 ethiopic greek-iso8859-7
580 hebrew-iso8859-8 japanese-jisx0208 japanese-jisx0212 581 hebrew-iso8859-8 japanese-jisx0208 japanese-jisx0212
581 katakana-jisx0201 korean-ksc5601 latin-iso8859-1 582 katakana-jisx0201 korean-ksc5601 latin-iso8859-1
582 latin-iso8859-2 vietnamese-viscii-lower))) 583 latin-iso8859-2 vietnamese-viscii-lower)))
583 (Assert-equal 584 (Assert (equal
584 ;; The sort is to make the algorithm of charsets-in-region 585 ;; The sort is to make the algorithm of charsets-in-region
585 ;; irrelevant. 586 ;; irrelevant.
586 (sort (charsets-in-region (point-min) (point-max)) 587 (sort (charsets-in-region (point-min) (point-max))
587 #'string<) 588 #'string<)
588 sorted-charsets-in-HELLO) 589 sorted-charsets-in-HELLO))
589 (Assert-equal 590 (Assert (equal
590 (sort (charsets-in-string (buffer-substring (point-min) 591 (sort (charsets-in-string (buffer-substring (point-min)
591 (point-max))) 592 (point-max)))
592 #'string<) 593 #'string<)
593 sorted-charsets-in-HELLO))) 594 sorted-charsets-in-HELLO))))
594 595
595 ;;--------------------------------------------------------------- 596 ;;---------------------------------------------------------------
596 ;; Language environments, and whether the specified values are sane. 597 ;; Language environments, and whether the specified values are sane.
597 ;;--------------------------------------------------------------- 598 ;;---------------------------------------------------------------
598 (loop 599 (loop
601 with native-coding-system = nil 602 with native-coding-system = nil
602 with original-language-environment = current-language-environment 603 with original-language-environment = current-language-environment
603 do 604 do
604 ;; s-l-e can call #'require, which says "Loading ..." 605 ;; s-l-e can call #'require, which says "Loading ..."
605 (Silence-Message (set-language-environment language)) 606 (Silence-Message (set-language-environment language))
606 (Assert-equal language current-language-environment) 607 (Assert (equal language current-language-environment))
607 608
608 (setq language-input-method 609 (setq language-input-method
609 (get-language-info language 'input-method)) 610 (get-language-info language 'input-method))
610 (when (and language-input-method 611 (when (and language-input-method
611 ;; #### Not robust, if more input methods besides canna are 612 ;; #### Not robust, if more input methods besides canna are
621 "input method unavailable" 622 "input method unavailable"
622 (format "check that IM %s can be activated" language-input-method) 623 (format "check that IM %s can be activated" language-input-method)
623 ;; s-i-m can load files. 624 ;; s-i-m can load files.
624 (Silence-Message 625 (Silence-Message
625 (set-input-method language-input-method)) 626 (set-input-method language-input-method))
626 (Assert-equal language-input-method current-input-method))) 627 (Assert (equal language-input-method current-input-method))))
627 628
628 (dolist (charset (get-language-info language 'charset)) 629 (dolist (charset (get-language-info language 'charset))
629 (Assert (charsetp (find-charset charset)))) 630 (Assert (charsetp (find-charset charset))))
630 (dolist (coding-system (get-language-info language 'coding-system)) 631 (dolist (coding-system (get-language-info language 'coding-system))
631 (Assert (coding-system-p (find-coding-system coding-system)))) 632 (Assert (coding-system-p (find-coding-system coding-system))))