Mercurial > hg > xemacs-beta
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)))) |