Mercurial > hg > xemacs-beta
annotate tests/automated/mule-tests.el @ 5576:071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
lisp/ChangeLog addition:
2011-10-03 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (handle-pre-motion-command-current-command-is-motion):
Implement #'keysyms-equal with #'labels + (declare (inline ...)),
instead of abusing macrolet to the same end.
* specifier.el (let-specifier):
* mule/mule-cmds.el (describe-language-environment):
* mule/mule-cmds.el (set-language-environment-coding-systems):
* mule/mule-x-init.el (x-use-halfwidth-roman-font):
* faces.el (Face-frob-property):
* keymap.el (key-sequence-list-description):
* lisp-mode.el (construct-lisp-mode-menu):
* loadhist.el (unload-feature):
* mouse.el (default-mouse-track-check-for-activation):
Declare various labels inline in dumped files when that reduces
the size of the dumped image. Declaring labels inline is normally
only worthwhile for inner loops and so on, but it's reasonable
exercise of the related code to have these changes in core.
tests/ChangeLog addition:
2011-10-03 Aidan Kehoe <kehoea@parhasard.net>
* automated/case-tests.el (uni-mappings):
* automated/database-tests.el (delete-database-files):
* automated/hash-table-tests.el (iterations):
* automated/lisp-tests.el (test1):
* automated/lisp-tests.el (a):
* automated/lisp-tests.el (cl-floor):
* automated/lisp-tests.el (foo):
* automated/lisp-tests.el (list-nreverse):
* automated/lisp-tests.el (needs-lexical-context):
* automated/mule-tests.el (featurep):
* automated/os-tests.el (original-string):
* automated/os-tests.el (with):
* automated/symbol-tests.el (check-weak-list-unique):
Replace #'flet with #'labels where appropriate in these tests,
following my own advice on style in the docstrings of those
functions.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 03 Oct 2011 20:16:14 +0100 |
| parents | 17bcc2aab111 |
| children | 391d809fa4e9 |
| rev | line source |
|---|---|
| 428 | 1 ;; Copyright (C) 1999 Free Software Foundation, Inc. |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
2 ;; Copyright (C) 2010 Ben Wing. |
| 428 | 3 |
| 4 ;; Author: Hrvoje Niksic <hniksic@xemacs.org> | |
| 440 | 5 ;; Maintainers: Hrvoje Niksic <hniksic@xemacs.org>, |
| 6 ;; Martin Buchholz <martin@xemacs.org> | |
| 428 | 7 ;; Created: 1999 |
| 8 ;; Keywords: tests | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
15 ;; option) any later version. |
| 428 | 16 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
20 ;; for more details. |
| 428 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 24 |
| 25 ;;; Synched up with: Not in FSF. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;; Test some Mule functionality (most of these remain to be written) . | |
| 30 ;; See test-harness.el for instructions on how to run these tests. | |
| 31 | |
| 434 | 32 ;; This file will be (read)ed by a non-mule XEmacs, so don't use |
| 33 ;; literal non-Latin1 characters. Use (make-char) instead. | |
| 34 | |
| 3948 | 35 (require 'bytecomp) |
| 36 | |
| 428 | 37 ;;----------------------------------------------------------------- |
| 38 ;; Test whether all legal chars may be safely inserted to a buffer. | |
| 39 ;;----------------------------------------------------------------- | |
| 40 | |
| 41 (defun test-chars (&optional for-test-harness) | |
| 42 "Insert all characters in a buffer, to see if XEmacs will crash. | |
| 43 This is done by creating a string with all the legal characters | |
| 4133 | 44 in [0, 2^21) range, inserting it into the buffer, and checking |
| 428 | 45 that the buffer's contents are equivalent to the string. |
| 46 | |
| 47 If FOR-TEST-HARNESS is specified, a temporary buffer is used, and | |
| 48 the Assert macro checks for correctness." | |
| 4133 | 49 (let ((max (expt 2 (if (featurep 'mule) 21 8))) |
| 428 | 50 (list nil) |
| 51 (i 0)) | |
| 52 (while (< i max) | |
| 53 (and (not for-test-harness) | |
| 54 (zerop (% i 1000)) | |
| 55 (message "%d" i)) | |
| 56 (and (int-char i) | |
| 57 ;; Don't aset to a string directly because random string | |
| 58 ;; access is O(n) under Mule. | |
| 59 (setq list (cons (int-char i) list))) | |
| 60 (setq i (1+ i))) | |
| 61 (let ((string (apply #'string (nreverse list)))) | |
| 62 (if for-test-harness | |
| 63 ;; For use with test-harness, use Assert and a temporary | |
| 64 ;; buffer. | |
| 65 (with-temp-buffer | |
| 66 (insert string) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
67 (Assert (equal (buffer-string) string))) |
| 428 | 68 ;; For use without test harness: use a normal buffer, so that |
| 69 ;; you can also test whether redisplay works. | |
| 70 (switch-to-buffer (get-buffer-create "test")) | |
| 71 (erase-buffer) | |
| 72 (buffer-disable-undo) | |
| 73 (insert string) | |
| 74 (assert (equal (buffer-string) string)))))) | |
| 75 | |
| 76 ;; It would be really *really* nice if test-harness allowed a way to | |
| 77 ;; run a test in byte-compiled mode only. It's tedious to have | |
| 78 ;; time-consuming tests like this one run twice, once interpreted and | |
| 79 ;; once compiled, for no good reason. | |
| 80 (test-chars t) | |
| 434 | 81 |
| 3439 | 82 (defun unicode-code-point-to-utf-8-string (code-point) |
| 83 "Convert a Unicode code point to the equivalent UTF-8 string. | |
| 84 This is a naive implementation in Lisp. " | |
| 85 (check-argument-type 'natnump code-point) | |
| 86 (check-argument-range code-point 0 #x1fffff) | |
| 87 (if (< code-point #x80) | |
| 88 (format "%c" code-point) | |
| 89 (if (< code-point #x800) | |
| 90 (format "%c%c" | |
| 91 ;; ochars[0] = 0xC0 | (input & ~(0xFFFFF83F)) >> 6; | |
| 92 (logior #xc0 (lsh (logand code-point #x7c0) -6)) | |
| 93 ;; ochars[1] = 0x80 | input & ~(0xFFFFFFC0); | |
| 94 (logior #x80 (logand code-point #x3f))) | |
| 95 (if (< code-point #x00010000) | |
| 96 (format "%c%c%c" | |
| 97 ;; ochars[0] = 0xE0 | (input >> 12) & ~(0xFFFFFFF0); | |
| 98 (logior #xe0 (logand (lsh code-point -12) #x0f)) | |
| 99 ;; ochars[1] = 0x80 | (input >> 6) & ~(0xFFFFFFC0); | |
| 100 (logior #x80 (logand (lsh code-point -6) #x3f)) | |
| 101 ;; ochars[2] = 0x80 | input & ~(0xFFFFFFC0); | |
| 102 (logior #x80 (logand code-point #x3f))) | |
| 103 (if (< code-point #x200000) | |
| 104 (format "%c%c%c%c" | |
| 105 ;; ochars[0] = 0xF0 | (input >> 18) & ~(0xFFFFFFF8) | |
| 106 (logior #xF0 (logand (lsh code-point -18) #x7)) | |
| 107 ;; ochars[1] = 0x80 | (input >> 12) & ~(0xFFFFFFC0); | |
| 108 (logior #x80 (logand (lsh code-point -12) #x3f)) | |
| 109 ;; ochars[2] = 0x80 | (input >> 6) & ~(0xFFFFFFC0); | |
| 110 (logior #x80 (logand (lsh code-point -6) #x3f)) | |
| 111 ;; ochars[3] = 0x80 | input & ~(0xFFFFFFC0); | |
| 112 (logior #x80 (logand code-point #x3f)))))))) | |
| 113 | |
| 4026 | 114 ;;---------------------------------------------------------------- |
| 115 ;; Test that revert-buffer resets the modiff | |
| 116 ;; Bug reported 2007-06-20 <200706201902.32191.scop@xemacs.org>. | |
| 117 ;; Fixed 2007-06-22 <18043.2793.611745.734215@parhasard.net>. | |
| 118 ;;---------------------------------------------------------------- | |
| 119 | |
|
4399
e5b3c4dbc8a2
Call #'make-temp-file in mule-tests.el, now it's available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4318
diff
changeset
|
120 (let ((test-file-name |
|
e5b3c4dbc8a2
Call #'make-temp-file in mule-tests.el, now it's available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4318
diff
changeset
|
121 (make-temp-file (expand-file-name "tXfXsKc" (temp-directory)))) |
| 4026 | 122 revert-buffer-function |
| 123 kill-buffer-hook) ; paranoia | |
| 124 (find-file test-file-name) | |
| 125 (erase-buffer) | |
| 126 (insert "a string\n") | |
| 4133 | 127 (Silence-Message (save-buffer 0)) |
| 4026 | 128 (insert "more text\n") |
| 129 (revert-buffer t t) | |
| 130 ;; Just "find-file" with autodetect coding didn't fail for me, but it does | |
| 131 ;; fail under test harness. Still we'll redo the test with an explicit | |
| 132 ;; coding system just in case. | |
| 133 (Assert (not (buffer-modified-p))) | |
| 134 (kill-buffer nil) | |
| 135 (when (find-coding-system 'utf-8) | |
| 136 (find-file test-file-name 'utf-8) | |
| 137 (insert "more text\n") | |
| 138 (revert-buffer t t) | |
| 139 (Assert (not (buffer-modified-p))) | |
| 140 (kill-buffer nil)) | |
| 141 (delete-file test-file-name)) | |
| 142 | |
|
4647
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
143 (let ((existing-file-name |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
144 (make-temp-file (expand-file-name "k7lCS2Mg" (temp-directory)))) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
145 (nonexistent-file-name |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
146 (make-temp-name (temp-directory)))) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
147 (find-file existing-file-name) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
148 (Assert (not (eq 'undecided |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
149 (coding-system-type buffer-file-coding-system)))) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
150 (kill-buffer nil) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
151 (dolist (coding-system '(utf-8 windows-1251 macintosh big5)) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
152 (when (find-coding-system coding-system) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
153 (find-file existing-file-name coding-system) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
154 (Assert (eq (find-coding-system coding-system) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
155 buffer-file-coding-system)) |
|
4647
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
156 (kill-buffer nil) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
157 (find-file nonexistent-file-name coding-system) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
158 (Assert (eq (find-coding-system coding-system) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
159 buffer-file-coding-system)) |
|
4650
8905163c49c5
#'find-file: set b-f-c-s even on error (cf. non-existent files),
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
160 (set-buffer-modified-p nil) |
|
4647
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
161 (kill-buffer nil))) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
162 (delete-file existing-file-name)) |
|
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
163 |
| 434 | 164 ;;----------------------------------------------------------------- |
| 165 ;; Test string modification functions that modify the length of a char. | |
| 166 ;;----------------------------------------------------------------- | |
| 167 | |
| 168 (when (featurep 'mule) | |
| 442 | 169 ;;--------------------------------------------------------------- |
| 434 | 170 ;; Test fillarray |
| 442 | 171 ;;--------------------------------------------------------------- |
| 434 | 172 (macrolet |
| 173 ((fillarray-test | |
| 174 (charset1 charset2) | |
| 175 (let ((char1 (make-char charset1 69)) | |
| 176 (char2 (make-char charset2 69))) | |
| 177 `(let ((string (make-string 1000 ,char1))) | |
| 178 (fillarray string ,char2) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
179 (Assert (eq (aref string 0) ,char2)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
180 (Assert (eq (aref string (1- (length string))) ,char2)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
181 (Assert (eq (length string) 1000)))))) |
| 434 | 182 (fillarray-test ascii latin-iso8859-1) |
| 183 (fillarray-test ascii latin-iso8859-2) | |
| 184 (fillarray-test latin-iso8859-1 ascii) | |
| 185 (fillarray-test latin-iso8859-2 ascii)) | |
| 186 | |
| 187 ;; Test aset | |
| 188 (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69)))) | |
| 189 (aset string 0 (make-char 'latin-iso8859-2 42)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
190 (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69)))) |
| 434 | 191 |
| 442 | 192 ;;--------------------------------------------------------------- |
| 440 | 193 ;; Test coding system functions |
| 442 | 194 ;;--------------------------------------------------------------- |
| 440 | 195 |
| 196 ;; Create alias for coding system without subsidiaries | |
| 197 (Assert (coding-system-p (find-coding-system 'binary))) | |
| 198 (Assert (coding-system-canonical-name-p 'binary)) | |
| 199 (Assert (not (coding-system-alias-p 'binary))) | |
| 200 (Assert (not (coding-system-alias-p 'mule-tests-alias))) | |
| 201 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 202 (Check-Error-Message | |
| 203 error "Symbol is the canonical name of a coding system and cannot be redefined" | |
| 204 (define-coding-system-alias 'binary 'iso8859-2)) | |
| 205 (Check-Error-Message | |
| 206 error "Symbol is not a coding system alias" | |
| 207 (coding-system-aliasee 'binary)) | |
| 208 | |
| 209 (define-coding-system-alias 'mule-tests-alias 'binary) | |
| 210 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 211 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
212 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
213 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) |
| 440 | 214 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) |
| 215 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) | |
| 216 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) | |
| 217 | |
| 218 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary)) | |
| 219 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 220 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
221 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
222 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) |
| 440 | 223 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) |
| 224 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) | |
| 225 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) | |
| 226 | |
| 227 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) | |
| 228 (Assert (coding-system-alias-p 'nested-mule-tests-alias)) | |
| 229 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
230 (Assert (eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
231 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
232 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) |
| 440 | 233 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix))) |
| 234 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) | |
| 235 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac))) | |
| 236 | |
| 237 (Check-Error-Message | |
| 238 error "Attempt to create a coding system alias loop" | |
| 239 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias)) | |
| 240 (Check-Error-Message | |
| 241 error "No such coding system" | |
| 242 (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system)) | |
| 243 (Check-Error-Message | |
| 244 error "Attempt to create a coding system alias loop" | |
| 245 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias)) | |
| 246 | |
| 247 (define-coding-system-alias 'nested-mule-tests-alias nil) | |
| 248 (define-coding-system-alias 'mule-tests-alias nil) | |
| 249 (Assert (coding-system-p (find-coding-system 'binary))) | |
| 250 (Assert (coding-system-canonical-name-p 'binary)) | |
| 251 (Assert (not (coding-system-alias-p 'binary))) | |
| 252 (Assert (not (coding-system-alias-p 'mule-tests-alias))) | |
| 253 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 254 (Check-Error-Message | |
| 255 error "Symbol is the canonical name of a coding system and cannot be redefined" | |
| 256 (define-coding-system-alias 'binary 'iso8859-2)) | |
| 257 (Check-Error-Message | |
| 258 error "Symbol is not a coding system alias" | |
| 259 (coding-system-aliasee 'binary)) | |
| 260 | |
| 261 (define-coding-system-alias 'nested-mule-tests-alias nil) | |
| 262 (define-coding-system-alias 'mule-tests-alias nil) | |
| 263 | |
| 264 ;; Create alias for coding system with subsidiaries | |
| 265 (define-coding-system-alias 'mule-tests-alias 'iso-8859-7) | |
| 266 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 267 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
268 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
269 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) |
| 440 | 270 (Assert (coding-system-alias-p 'mule-tests-alias-unix)) |
| 271 (Assert (coding-system-alias-p 'mule-tests-alias-dos)) | |
| 272 (Assert (coding-system-alias-p 'mule-tests-alias-mac)) | |
| 273 | |
| 274 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'iso-8859-7)) | |
| 275 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 276 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
277 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
278 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) |
| 440 | 279 (Assert (coding-system-alias-p 'mule-tests-alias-unix)) |
| 280 (Assert (coding-system-alias-p 'mule-tests-alias-dos)) | |
| 281 (Assert (coding-system-alias-p 'mule-tests-alias-mac)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
282 (Assert (eq (find-coding-system 'mule-tests-alias-mac) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
283 (find-coding-system 'iso-8859-7-mac))) |
| 440 | 284 |
| 285 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) | |
| 286 (Assert (coding-system-alias-p 'nested-mule-tests-alias)) | |
| 287 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
288 (Assert (eq (get-coding-system 'iso-8859-7) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
289 (get-coding-system 'nested-mule-tests-alias))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
290 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
291 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) |
| 440 | 292 (Assert (coding-system-alias-p 'nested-mule-tests-alias-unix)) |
| 293 (Assert (coding-system-alias-p 'nested-mule-tests-alias-dos)) | |
| 294 (Assert (coding-system-alias-p 'nested-mule-tests-alias-mac)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
295 (Assert (eq (find-coding-system 'nested-mule-tests-alias-unix) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
296 (find-coding-system 'iso-8859-7-unix))) |
| 440 | 297 |
| 298 (Check-Error-Message | |
| 299 error "Attempt to create a coding system alias loop" | |
| 300 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias)) | |
| 301 (Check-Error-Message | |
| 302 error "No such coding system" | |
| 303 (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system)) | |
| 304 (Check-Error-Message | |
| 305 error "Attempt to create a coding system alias loop" | |
| 306 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias)) | |
| 307 | |
| 308 ;; Test dangling alias deletion | |
| 309 (define-coding-system-alias 'mule-tests-alias nil) | |
| 310 (Assert (not (coding-system-alias-p 'mule-tests-alias))) | |
| 311 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) | |
| 312 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias))) | |
| 313 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) | |
| 314 | |
| 442 | 315 ;;--------------------------------------------------------------- |
| 438 | 316 ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c) |
| 442 | 317 ;;--------------------------------------------------------------- |
| 438 | 318 (defun charset-char-string (charset) |
| 2026 | 319 (let (lo hi string n (gc-cons-threshold most-positive-fixnum)) |
| 438 | 320 (if (= (charset-chars charset) 94) |
| 321 (setq lo 33 hi 126) | |
| 322 (setq lo 32 hi 127)) | |
| 323 (if (= (charset-dimension charset) 1) | |
| 324 (progn | |
| 325 (setq string (make-string (1+ (- hi lo)) ??)) | |
| 326 (setq n 0) | |
| 327 (loop for j from lo to hi do | |
| 328 (progn | |
| 329 (aset string n (make-char charset j)) | |
| 330 (incf n))) | |
| 2026 | 331 (garbage-collect) |
| 438 | 332 string) |
| 333 (progn | |
| 334 (setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??)) | |
| 335 (setq n 0) | |
| 336 (loop for j from lo to hi do | |
| 337 (loop for k from lo to hi do | |
| 338 (progn | |
| 339 (aset string n (make-char charset j k)) | |
| 340 (incf n)))) | |
| 2026 | 341 (garbage-collect) |
| 438 | 342 string)))) |
| 343 | |
| 344 ;; The following two used to crash xemacs! | |
| 345 (Assert (charset-char-string 'japanese-jisx0208)) | |
| 346 (aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 77)) | |
| 347 | |
| 348 (let ((greek-string (charset-char-string 'greek-iso8859-7)) | |
| 349 (string (make-string (* 96 60) ??))) | |
| 350 (loop for j from 0 below (length string) do | |
| 351 (aset string j (aref greek-string (mod j 96)))) | |
| 352 (loop for k in '(0 1 58 59) do | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
353 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) |
| 438 | 354 |
| 355 (let ((greek-string (charset-char-string 'greek-iso8859-7)) | |
| 356 (string (make-string (* 96 60) ??))) | |
| 357 (loop for j from (1- (length string)) downto 0 do | |
| 358 (aset string j (aref greek-string (mod j 96)))) | |
| 359 (loop for k in '(0 1 58 59) do | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
360 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) |
| 438 | 361 |
| 362 (let ((ascii-string (charset-char-string 'ascii)) | |
| 363 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) | |
| 364 (loop for j from 0 below (length string) do | |
| 365 (aset string j (aref ascii-string (mod j 94)))) | |
| 366 (loop for k in '(0 1 58 59) do | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
367 (Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string)))) |
| 438 | 368 |
| 369 (let ((ascii-string (charset-char-string 'ascii)) | |
| 370 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) | |
| 371 (loop for j from (1- (length string)) downto 0 do | |
| 372 (aset string j (aref ascii-string (mod j 94)))) | |
| 373 (loop for k in '(0 1 58 59) do | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
374 (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string)))) |
| 438 | 375 |
| 442 | 376 ;;--------------------------------------------------------------- |
|
5107
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
377 ;; Test string character conversion |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
378 ;;--------------------------------------------------------------- |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
379 |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
380 ;; #### This should test all coding systems! |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
381 |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
382 (let ((all-octets (let ((s (make-string 256 ?\000))) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
383 (loop for i from (1- (length s)) downto 0 do |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
384 (aset s i (int-char i))) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
385 s)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
386 (escape-quoted-result (let ((schar '(27 155 142 143 14 15)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
387 (s (make-string 262 ?\000)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
388 (pos 0)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
389 (loop for ord from 0 to 255 do |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
390 (when (member ord schar) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
391 (aset s pos ?\033) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
392 (incf pos)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
393 (aset s pos (int-char ord)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
394 (incf pos)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
395 s))) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
396 (Assert (string= (encode-coding-string all-octets 'escape-quoted) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
397 escape-quoted-result))) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
398 |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
399 ;;--------------------------------------------------------------- |
| 442 | 400 ;; Test file-system character conversion (and, en passant, file ops) |
| 401 ;;--------------------------------------------------------------- | |
| 3970 | 402 (let* ((dstroke (make-char 'latin-iso8859-2 80)) |
| 403 (latin2-string (make-string 4 dstroke)) | |
| 597 | 404 (prefix (concat (file-name-as-directory |
| 405 (file-truename (temp-directory))) | |
| 406 latin2-string)) | |
| 2026 | 407 (file-name-coding-system |
| 408 ;; 'iso-8859-X doesn't work on darwin (as of "Panther" 10.3), it | |
| 409 ;; seems to know that file-name-coding-system is definitely utf-8 | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4731
diff
changeset
|
410 (if (or (string-match "darwin" system-configuration) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4731
diff
changeset
|
411 (featurep 'cygwin-use-utf-8)) |
| 2026 | 412 'utf-8 |
| 413 'iso-8859-2)) | |
| 3970 | 414 ;; make-temp-name does stat(), which on OS X requires that you |
| 415 ;; normalise, where open() will normalise for you. Previously we | |
| 416 ;; used scaron as the Latin-2 character, and make-temp-name errored | |
| 3976 | 417 ;; on OS X. LATIN CAPITAL LETTER D WITH STROKE does not decompose. |
| 3970 | 418 (name1 (make-temp-name prefix)) |
|
4465
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
419 (name2 (make-temp-name prefix)) |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
420 (name3 (make-temp-name prefix)) |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
421 working-symlinks) |
| 3472 | 422 (Assert (not (equal name1 name2))) |
| 423 (Assert (not (file-exists-p name1))) | |
|
4465
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
424 ;; This is how you suppress output from `message', called by `write-region' |
| 3472 | 425 (Silence-Message |
| 426 (write-region (point-min) (point-max) name1)) | |
| 427 (Assert (file-exists-p name1)) | |
|
4465
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
428 (Silence-Message |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
429 (write-region (point-min) (point-max) name3)) |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
430 (Assert (file-exists-p name3)) |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
431 (condition-case nil |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
432 (make-symbolic-link name1 name3) |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
433 (file-already-exists |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
434 ;; If we actually have functioning symlinks, we end up here, since |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
435 ;; name3 already exists and OK-IF-ALREADY-EXISTS was not specified. |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
436 (setq working-symlinks t))) |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
437 (when working-symlinks |
| 3472 | 438 (make-symbolic-link name1 name2) |
| 439 (Assert (file-exists-p name2)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
440 (Assert (equal (file-truename name2) name1)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
441 (Assert (equal (file-truename name1) name1))) |
|
4465
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
442 (ignore-file-errors (delete-file name1)) |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
443 (ignore-file-errors (delete-file name2)) |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
444 (ignore-file-errors (delete-file name3))) |
| 442 | 445 |
| 446 ;; Add many more file operation tests here... | |
| 447 | |
| 448 ;;--------------------------------------------------------------- | |
| 449 ;; Test Unicode-related functions | |
| 450 ;;--------------------------------------------------------------- | |
| 4861 | 451 (let* ((scaron (make-char 'latin-iso8859-2 57))) |
| 875 | 452 ;; Used to try #x0000, but you can't change ASCII or Latin-1 |
|
4715
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
453 (loop |
|
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
454 for code in '(#x0100 #x2222 #x4444 #xffff) |
| 4861 | 455 with initial-unicode = (char-to-unicode scaron) |
|
4715
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
456 do |
| 442 | 457 (progn |
| 4861 | 458 (set-unicode-conversion scaron code) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
459 (Assert (eq code (char-to-unicode scaron))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
460 (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2))))) |
| 4861 | 461 finally (set-unicode-conversion scaron initial-unicode)) |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
462 (Check-Error args-out-of-range (set-unicode-conversion scaron -10000))) |
| 1195 | 463 |
| 3439 | 464 (dolist (utf-8-char |
| 465 '("\xc6\x92" ;; U+0192 LATIN SMALL LETTER F WITH HOOK | |
| 466 "\xe2\x81\x8a" ;; U+204A TIRONIAN SIGN ET | |
| 467 "\xe2\x82\xae" ;; U+20AE TUGRIK SIGN | |
| 468 "\xf0\x9d\x92\xbd" ;; U+1D4BD MATHEMATICAL SCRIPT SMALL H | |
| 469 "\xf0\x9d\x96\x93" ;; U+1D593 MATHEMATICAL BOLD FRAKTUR SMALL N | |
| 470 "\xf0\xaf\xa8\x88" ;; U+2FA08 CJK COMPATIBILITY FOR U+4BCE | |
| 471 "\xf4\x8f\xbf\xbd")) ;; U+10FFFD <Plane 16 Private Use, Last> | |
| 472 (let* ((xemacs-character (car (append | |
| 473 (decode-coding-string utf-8-char 'utf-8) | |
| 474 nil))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
475 (xemacs-charset (car (split-char xemacs-character)))) |
| 3439 | 476 |
| 477 ;; Trivial test of the UTF-8 support of the escape-quoted character set. | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
478 (Assert (equal (decode-coding-string utf-8-char 'utf-8) |
| 3439 | 479 (decode-coding-string (concat "\033%G" utf-8-char) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
480 'escape-quoted))) |
| 3439 | 481 |
| 482 ;; Check that the reverse mapping holds. | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
483 (Assert (equal (unicode-code-point-to-utf-8-string |
| 3439 | 484 (encode-char xemacs-character 'ucs)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
485 utf-8-char)) |
| 3439 | 486 |
| 487 ;; Check that, if this character has been JIT-allocated, it is encoded | |
| 488 ;; in escape-quoted using the corresponding UTF-8 escape. | |
| 489 (when (charset-property xemacs-charset 'encode-as-utf-8) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
490 (Assert (equal (concat "\033%G" utf-8-char) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
491 (encode-coding-string xemacs-character 'escape-quoted))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
492 (Assert (equal (concat "\033%G" utf-8-char) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
493 (encode-coding-string xemacs-character 'ctext)))))) |
| 3439 | 494 |
| 3952 | 495 (loop |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
496 for (code-point utf-16-big-endian utf-16-little-endian) |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
497 in '((#x10000 "\xd8\x00\xdc\x00" "\x00\xd8\x00\xdc") |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
498 (#x10FFFD "\xdb\xff\xdf\xfd" "\xff\xdb\xfd\xdf")) |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
499 do |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
500 (Assert (equal (encode-coding-string |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
501 (decode-char 'ucs code-point) 'utf-16) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
502 utf-16-big-endian)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
503 (Assert (equal (encode-coding-string |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
504 (decode-char 'ucs code-point) 'utf-16-le) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
505 utf-16-little-endian))) |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
506 |
| 3952 | 507 |
| 1195 | 508 ;;--------------------------------------------------------------- |
| 3690 | 509 ;; Regression test for a couple of CCL-related bugs. |
| 510 ;;--------------------------------------------------------------- | |
| 511 | |
| 512 (let ((ccl-vector [0 0 0 0 0 0 0 0 0])) | |
| 513 (define-ccl-program ccl-write-two-control-1-chars | |
| 514 `(1 | |
| 515 ((r0 = ,(charset-id 'control-1)) | |
| 516 (r1 = 0) | |
| 517 (write-multibyte-character r0 r1) | |
| 518 (r1 = 31) | |
| 519 (write-multibyte-character r0 r1))) | |
| 520 "CCL program that writes two control-1 multibyte characters.") | |
| 521 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
522 (Assert (equal |
| 3690 | 523 (ccl-execute-on-string 'ccl-write-two-control-1-chars |
| 524 ccl-vector "") | |
| 525 (format "%c%c" (make-char 'control-1 0) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
526 (make-char 'control-1 31)))) |
| 3690 | 527 |
| 528 (define-ccl-program ccl-unicode-two-control-1-chars | |
| 529 `(1 | |
| 530 ((r0 = ,(charset-id 'control-1)) | |
| 531 (r1 = 31) | |
| 532 (mule-to-unicode r0 r1) | |
| 533 (r4 = r0) | |
| 534 (r3 = ,(charset-id 'control-1)) | |
| 535 (r2 = 0) | |
| 536 (mule-to-unicode r3 r2))) | |
| 537 "CCL program that writes two control-1 UCS code points in r3 and r4") | |
| 538 | |
| 539 ;; Re-initialise the vector, mainly to clear the instruction counter, | |
| 540 ;; which is its last element. | |
| 541 (setq ccl-vector [0 0 0 0 0 0 0 0 0]) | |
| 542 | |
| 543 (ccl-execute-on-string 'ccl-unicode-two-control-1-chars ccl-vector "") | |
| 544 | |
| 545 (Assert (and (eq (aref ccl-vector 3) | |
| 546 (encode-char (make-char 'control-1 0) 'ucs)) | |
| 547 (eq (aref ccl-vector 4) | |
| 548 (encode-char (make-char 'control-1 31) 'ucs))))) | |
| 549 | |
| 4295 | 550 |
| 551 ;; Test the 8 bit fixed-width coding systems for round-trip | |
| 552 ;; compatibility with themselves. | |
| 553 (loop | |
| 554 for coding-system in (coding-system-list) | |
| 555 with all-possible-octets = (apply #'string | |
| 556 (loop for i from ?\x00 to ?\xFF | |
| 557 collect i)) | |
| 558 do | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4688
diff
changeset
|
559 (when (and (eq 'fixed-width (coding-system-type coding-system)) |
|
4715
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
560 ;; Don't check the coding systems with odd line endings |
|
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
561 ;; (maybe we should): |
|
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
562 (eq 'lf (coding-system-eol-type coding-system))) |
| 4295 | 563 ;; These coding systems are round-trip compatible with themselves. |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
564 (Assert (equal (encode-coding-string |
| 4295 | 565 (decode-coding-string all-possible-octets |
| 566 coding-system) | |
| 567 coding-system) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
568 all-possible-octets) |
|
4715
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
569 (format "checking %s is transparent" coding-system)))) |
| 4295 | 570 |
| 3690 | 571 ;;--------------------------------------------------------------- |
| 1195 | 572 ;; Test charset-in-* functions |
| 573 ;;--------------------------------------------------------------- | |
| 574 (with-temp-buffer | |
|
4884
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
575 (let ((sorted-charsets-in-HELLO |
|
5530
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
576 '(arabic-iso8859-6 ascii chinese-big5-1 chinese-gb2312 |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
577 cyrillic-iso8859-5 ethiopic greek-iso8859-7 hebrew-iso8859-8 |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
578 indian-is13194 ipa japanese-jisx0208 japanese-jisx0212 |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
579 katakana-jisx0201 korean-ksc5601 lao latin-iso8859-1 |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
580 latin-iso8859-2 latin-iso8859-3 latin-iso8859-4 thai-tis620 |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
581 tibetan vietnamese-viscii-lower)) |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
582 (coding-system-for-read 'iso-2022-7)) |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
583 (insert-file-contents (locate-data-file "HELLO")) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
584 (Assert (equal |
|
4884
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
585 ;; The sort is to make the algorithm of charsets-in-region |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
586 ;; irrelevant. |
|
5530
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
587 (sort (remove* "^jit-ucs-charset-" (charsets-in-region (point-min) |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
588 (point-max)) |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
589 :test 'string-match :key 'symbol-name) |
|
4884
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
590 #'string<) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
591 sorted-charsets-in-HELLO)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
592 (Assert (equal |
|
5530
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
593 (sort (remove* "^jit-ucs-charset-" (charsets-in-string |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
594 (buffer-substring (point-min) |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
595 (point-max))) |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
596 :test 'string-match :key 'symbol-name) |
|
4884
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
597 #'string<) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
598 sorted-charsets-in-HELLO)))) |
| 3948 | 599 |
| 4133 | 600 ;;--------------------------------------------------------------- |
| 601 ;; Language environments, and whether the specified values are sane. | |
| 602 ;;--------------------------------------------------------------- | |
| 603 (loop | |
| 604 for language in (mapcar #'car language-info-alist) | |
| 605 with language-input-method = nil | |
| 4305 | 606 with native-coding-system = nil |
|
4672
938ffa3ffe4d
Revert to original language environment, tests/automated/mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4650
diff
changeset
|
607 with original-language-environment = current-language-environment |
| 4133 | 608 do |
| 609 ;; s-l-e can call #'require, which says "Loading ..." | |
| 610 (Silence-Message (set-language-environment language)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
611 (Assert (equal language current-language-environment)) |
| 4133 | 612 |
| 613 (setq language-input-method | |
| 614 (get-language-info language 'input-method)) | |
| 615 (when (and language-input-method | |
| 616 ;; #### Not robust, if more input methods besides canna are | |
| 617 ;; in core. The intention of this is that if *any* of the | |
| 618 ;; packages' input methods are available, we check that *all* | |
| 619 ;; of the language environments' input methods actually | |
| 620 ;; exist, which goes against the spirit of non-monolithic | |
| 621 ;; packages. But I don't have a better approach to this. | |
| 622 (> (length input-method-alist) 1)) | |
| 623 (Assert (assoc language-input-method input-method-alist)) | |
| 624 (Skip-Test-Unless | |
| 625 (assoc language-input-method input-method-alist) | |
| 626 "input method unavailable" | |
| 627 (format "check that IM %s can be activated" language-input-method) | |
| 628 ;; s-i-m can load files. | |
| 629 (Silence-Message | |
| 630 (set-input-method language-input-method)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
631 (Assert (equal language-input-method current-input-method)))) |
| 4133 | 632 |
| 3970 | 633 (dolist (charset (get-language-info language 'charset)) |
| 634 (Assert (charsetp (find-charset charset)))) | |
| 635 (dolist (coding-system (get-language-info language 'coding-system)) | |
| 636 (Assert (coding-system-p (find-coding-system coding-system)))) | |
| 4305 | 637 (dolist (coding-system |
| 638 (if (listp (setq native-coding-system | |
| 639 (get-language-info language | |
| 640 'native-coding-system))) | |
| 641 native-coding-system | |
| 642 (list native-coding-system))) | |
| 4133 | 643 ;; We don't have the appropriate POSIX locales to test with a |
| 644 ;; native-coding-system that is a function. | |
| 645 (unless (functionp coding-system) | |
|
4672
938ffa3ffe4d
Revert to original language environment, tests/automated/mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4650
diff
changeset
|
646 (Assert (coding-system-p (find-coding-system coding-system))))) |
|
938ffa3ffe4d
Revert to original language environment, tests/automated/mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4650
diff
changeset
|
647 finally (set-language-environment original-language-environment)) |
| 3970 | 648 |
| 3948 | 649 (with-temp-buffer |
|
5576
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5530
diff
changeset
|
650 (labels |
| 3948 | 651 ((Assert-elc-is-escape-quoted () |
| 652 "Assert the current buffer has an escape-quoted cookie if compiled." | |
| 653 (save-excursion | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
654 (let* ((temporary-file-name (make-temp-name |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
655 (expand-file-name "zjPQ2Pk" |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
656 (temp-directory)))) |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
657 (byte-compile-result (byte-compile-from-buffer |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
658 (current-buffer) temporary-file-name |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
659 nil))) |
| 4133 | 660 (Assert (string-match |
| 661 "^;;;###coding system: escape-quoted" | |
| 662 (buffer-substring nil nil byte-compile-result)))))) | |
| 3948 | 663 (Assert-elc-has-no-specified-encoding () |
| 664 "Assert the current buffer has no coding cookie if compiled." | |
| 665 (save-excursion | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
666 (let* ((temporary-file-name (make-temp-name |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
667 (expand-file-name "zjPQ2Pk" |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
668 (temp-directory)))) |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
669 (byte-compile-result (byte-compile-from-buffer |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
670 (current-buffer) temporary-file-name |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
671 nil))) |
| 3948 | 672 (Assert (not (string-match |
| 673 ";;;###coding system:" | |
| 4133 | 674 (buffer-substring nil nil |
| 675 byte-compile-result)))))))) | |
| 3948 | 676 (insert |
| 4133 | 677 ;; Create a buffer with Unicode escapes. The #'read call is at |
| 678 ;; runtime, because this file may be compiled and read in a non-Mule | |
| 679 ;; XEmacs. (But it won't be run.) | |
| 680 (read | |
| 681 "#r\" (defvar testing-mule-compilation-handling | |
| 682 (string ?\\u371E ;; kDefinition beautiful; pretty, used | |
| 3948 | 683 ;; in girl's name |
| 4133 | 684 ?\\U0002A6A9 ;; kDefinition (Cant.) sound of shouting |
| 685 ?\\U0002A65B ;; kDefinition (Cant.) decayed teeth; | |
| 3948 | 686 ;; tongue-tied |
| 4133 | 687 ?\\U00010400 ;; DESERET CAPITAL LETTER LONG I |
| 688 ?\\u3263)) ;; CIRCLED HANGUL RIEUL \"")) | |
| 3948 | 689 |
| 690 (Assert-elc-is-escape-quoted) | |
| 691 (delete-region (point-min) (point-max)) | |
| 692 | |
| 693 (insert | |
| 694 ;; This time, the buffer will contain the actual characters, because of | |
| 695 ;; u flag to the #r. | |
| 4133 | 696 (read |
| 697 "#ru\" (defvar testing-mule-compilation-handling | |
| 698 (string ?\\u371E ;; kDefinition beautiful; pretty, used | |
| 3948 | 699 ;; in girl's name |
| 4133 | 700 ?\\U0002A6A9 ;; kDefinition (Cant.) sound of shouting |
| 701 ?\\U0002A65B ;; kDefinition (Cant.) decayed teeth; | |
| 3948 | 702 ;; tongue-tied |
| 4133 | 703 ?\\U00010400 ;; DESERET CAPITAL LETTER LONG I |
| 704 ?\\u3263)) ;; CIRCLED HANGUL RIEUL \"")) | |
| 3948 | 705 |
| 706 (Assert-elc-is-escape-quoted) | |
| 707 (delete-region (point-min) (point-max)) | |
| 708 | |
| 709 (insert | |
| 710 ;; Just a single four character escape. | |
| 4133 | 711 (read |
| 712 "#r\" (defvar testing-mule-compilation-handling | |
| 713 (string ?\\u371E)) ;; kDefinition beautiful; pretty, used\"")) | |
| 3948 | 714 |
| 715 (Assert-elc-is-escape-quoted) | |
| 716 (delete-region (point-min) (point-max)) | |
| 717 | |
| 718 (insert | |
| 719 ;; Just a single eight character escape. | |
| 4133 | 720 (read |
| 721 "#r\" (defvar testing-mule-compilation-handling | |
| 722 (string ?\\U0002A65B)) ;; kDefinition (Cant.) decayed teeth;\"")) | |
| 3948 | 723 |
| 724 (Assert-elc-is-escape-quoted) | |
| 725 (delete-region (point-min) (point-max)) | |
| 726 | |
| 727 (insert | |
| 4133 | 728 ;; A single latin-1 hex digit escape No run-time #'read call, |
| 729 ;; non-Mule can handle this too. | |
| 3948 | 730 #r" (defvar testing-mule-compilation-handling |
| 4133 | 731 (string ?\xab)) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK") |
| 732 | |
| 733 (Assert-elc-has-no-specified-encoding) | |
| 734 (delete-region (point-min) (point-max)) | |
| 735 | |
| 736 (insert | |
| 737 ;; A single latin-1 character. No run-time #'read call. | |
| 738 #ru" (defvar testing-mule-compilation-handling | |
| 739 (string ?\u00AB)) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK\")") | |
| 3948 | 740 |
| 741 (Assert-elc-has-no-specified-encoding) | |
| 742 (delete-region (point-min) (point-max)) | |
| 743 | |
| 744 (insert | |
| 4133 | 745 ;; Just ASCII. No run-time #'read call |
| 746 #r" (defvar testing-mule-compilation-handling | |
| 747 (string ?A)) ;; LATIN CAPITAL LETTER A") | |
| 3948 | 748 |
| 749 (Assert-elc-has-no-specified-encoding) | |
| 750 (delete-region (point-min) (point-max)) | |
| 751 | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
752 ;; There used to be a bug here because the coding-cookie insertion code |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
753 ;; looks at the input buffer, not the output buffer. |
| 4133 | 754 ;; |
| 755 ;; It looks at the input buffer because byte-compile-dynamic and | |
| 756 ;; byte-compile-dynamic-docstrings currently need to be | |
| 757 ;; unconditionally turned off for Mule files, since dynamic | |
| 758 ;; compilation of function bodies and docstrings fails if you can't | |
| 759 ;; call (point) and trivially get the byte offset in the file. | |
| 760 ;; | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
761 ;; And to unconditionally turn those two features off, you need to know |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
762 ;; before byte-compilation whether the byte-compilation output file |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
763 ;; contains non-Latin-1 characters. Or to check after compilation and |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
764 ;; redo; the latter is what we do right now. This will only be necessary |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
765 ;; in a very small minority of cases, it's not a performance-critical |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
766 ;; issue. |
| 4133 | 767 ;; |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
768 ;; Martin Buchholz thinks, in bytecomp.el, that we should implement lazy |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
769 ;; loading for Mule files; I (Aidan Kehoe) don't think that's worth the |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
770 ;; effort today (February 2009). |
| 3948 | 771 (insert |
| 4133 | 772 "(defvar testing-mule-compilation-handling (eval-when-compile |
| 773 (decode-char 'ucs #x371e))) ;; kDefinition beautiful; pretty, used\"") | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
774 (Assert-elc-is-escape-quoted) |
| 3948 | 775 (delete-region (point-min) (point-max)))) |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
776 |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
777 (Known-Bug-Expect-Error |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
778 invalid-constant |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
779 (loop |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
780 for i from #x0 to #x10FFFF |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
781 with exceptions = #s(range-table type start-closed-end-closed |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
782 data ((#xFFFE #xFFFF) t |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
783 (#xFDD0 #xFDEF) t |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
784 (#xD800 #xDBFF) t |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
785 (#xDC00 #xDFFF) t)) |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
786 do (unless (get-range-table i exceptions) |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
787 (read (format (if (> i #xFFFF) #r"?\U%08X" #r"?\u%04X") i))) |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
788 finally return t)) |
|
4688
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
789 (loop |
|
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
790 for i from #x00 to #xff |
|
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
791 do (Assert |
|
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
792 (= 1 (length (decode-coding-string (format "%c" i) 'utf-8-unix))) |
|
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
793 (format |
|
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
794 "checking Unicode coding systems behave well with short input, %02X" |
|
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
795 i))) |
|
4731
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
796 |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
797 ;;--------------------------------------------------------------- |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
798 ;; Process tests |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
799 ;; #### Should do network too. |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
800 ;;--------------------------------------------------------------- |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
801 (Skip-Test-Unless (and (file-exists-p "/dev/null") |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
802 (fboundp 'executable-find) |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
803 (executable-find "cat")) |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
804 "cat(1) or /dev/null missing" |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
805 "Test that default-process-coding-system can be nil." |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
806 (with-temp-buffer |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
807 (Assert (let (default-process-coding-system) |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
808 (shell-command "cat </dev/null >/dev/null") |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
809 t)))) |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
810 |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
811 ) ; end of tests that require MULE built in. |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
812 |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
813 ;;; end of mule-tests.el |