Mercurial > hg > xemacs-beta
annotate tests/automated/mule-tests.el @ 5912:47ffa085a9ad
Fix a bug when passing a float to truncate and giving a bignum result.
src/ChangeLog addition:
2015-05-10 Aidan Kehoe <kehoea@parhasard.net>
* floatfns.c (truncate_one_float):
Fix a bug here when double_to_integer() (and previously
float_to_int()) returned a bignum; this was silently treated as a
fixnum, giving consistently incorrect remainders and less
consistently-incorrect but still buggy divisors.
tests/ChangeLog addition:
Check that a bug when supplying #'truncate with one float that
rounds to a bignum, has been fixed.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 10 May 2015 23:55:41 +0100 |
| parents | 15041705c196 |
| children | 1b2fdcc3cc5c |
| 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." | |
|
5863
15041705c196
Provide `char-code-limit', implement the GNU equivalent in terms of it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5664
diff
changeset
|
49 (let ((list nil) |
| 428 | 50 (i 0)) |
|
5863
15041705c196
Provide `char-code-limit', implement the GNU equivalent in terms of it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5664
diff
changeset
|
51 (while (< i char-code-limit) |
| 428 | 52 (and (not for-test-harness) |
| 53 (zerop (% i 1000)) | |
| 54 (message "%d" i)) | |
| 55 (and (int-char i) | |
| 56 ;; Don't aset to a string directly because random string | |
| 57 ;; access is O(n) under Mule. | |
| 58 (setq list (cons (int-char i) list))) | |
| 59 (setq i (1+ i))) | |
| 60 (let ((string (apply #'string (nreverse list)))) | |
| 61 (if for-test-harness | |
| 62 ;; For use with test-harness, use Assert and a temporary | |
| 63 ;; buffer. | |
| 64 (with-temp-buffer | |
| 65 (insert string) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
66 (Assert (equal (buffer-string) string))) |
| 428 | 67 ;; For use without test harness: use a normal buffer, so that |
| 68 ;; you can also test whether redisplay works. | |
| 69 (switch-to-buffer (get-buffer-create "test")) | |
| 70 (erase-buffer) | |
| 71 (buffer-disable-undo) | |
| 72 (insert string) | |
| 73 (assert (equal (buffer-string) string)))))) | |
| 74 | |
| 75 ;; It would be really *really* nice if test-harness allowed a way to | |
| 76 ;; run a test in byte-compiled mode only. It's tedious to have | |
| 77 ;; time-consuming tests like this one run twice, once interpreted and | |
| 78 ;; once compiled, for no good reason. | |
| 79 (test-chars t) | |
| 434 | 80 |
| 3439 | 81 (defun unicode-code-point-to-utf-8-string (code-point) |
| 82 "Convert a Unicode code point to the equivalent UTF-8 string. | |
| 83 This is a naive implementation in Lisp. " | |
| 84 (check-argument-type 'natnump code-point) | |
| 85 (check-argument-range code-point 0 #x1fffff) | |
| 86 (if (< code-point #x80) | |
| 87 (format "%c" code-point) | |
| 88 (if (< code-point #x800) | |
| 89 (format "%c%c" | |
| 90 ;; ochars[0] = 0xC0 | (input & ~(0xFFFFF83F)) >> 6; | |
| 91 (logior #xc0 (lsh (logand code-point #x7c0) -6)) | |
| 92 ;; ochars[1] = 0x80 | input & ~(0xFFFFFFC0); | |
| 93 (logior #x80 (logand code-point #x3f))) | |
| 94 (if (< code-point #x00010000) | |
| 95 (format "%c%c%c" | |
| 96 ;; ochars[0] = 0xE0 | (input >> 12) & ~(0xFFFFFFF0); | |
| 97 (logior #xe0 (logand (lsh code-point -12) #x0f)) | |
| 98 ;; ochars[1] = 0x80 | (input >> 6) & ~(0xFFFFFFC0); | |
| 99 (logior #x80 (logand (lsh code-point -6) #x3f)) | |
| 100 ;; ochars[2] = 0x80 | input & ~(0xFFFFFFC0); | |
| 101 (logior #x80 (logand code-point #x3f))) | |
| 102 (if (< code-point #x200000) | |
| 103 (format "%c%c%c%c" | |
| 104 ;; ochars[0] = 0xF0 | (input >> 18) & ~(0xFFFFFFF8) | |
| 105 (logior #xF0 (logand (lsh code-point -18) #x7)) | |
| 106 ;; ochars[1] = 0x80 | (input >> 12) & ~(0xFFFFFFC0); | |
| 107 (logior #x80 (logand (lsh code-point -12) #x3f)) | |
| 108 ;; ochars[2] = 0x80 | (input >> 6) & ~(0xFFFFFFC0); | |
| 109 (logior #x80 (logand (lsh code-point -6) #x3f)) | |
| 110 ;; ochars[3] = 0x80 | input & ~(0xFFFFFFC0); | |
| 111 (logior #x80 (logand code-point #x3f)))))))) | |
| 112 | |
| 4026 | 113 ;;---------------------------------------------------------------- |
| 114 ;; Test that revert-buffer resets the modiff | |
| 115 ;; Bug reported 2007-06-20 <200706201902.32191.scop@xemacs.org>. | |
| 116 ;; Fixed 2007-06-22 <18043.2793.611745.734215@parhasard.net>. | |
| 117 ;;---------------------------------------------------------------- | |
| 118 | |
|
4399
e5b3c4dbc8a2
Call #'make-temp-file in mule-tests.el, now it's available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4318
diff
changeset
|
119 (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
|
120 (make-temp-file (expand-file-name "tXfXsKc" (temp-directory)))) |
| 4026 | 121 revert-buffer-function |
| 122 kill-buffer-hook) ; paranoia | |
| 123 (find-file test-file-name) | |
| 124 (erase-buffer) | |
| 125 (insert "a string\n") | |
| 4133 | 126 (Silence-Message (save-buffer 0)) |
| 4026 | 127 (insert "more text\n") |
| 128 (revert-buffer t t) | |
| 129 ;; Just "find-file" with autodetect coding didn't fail for me, but it does | |
| 130 ;; fail under test harness. Still we'll redo the test with an explicit | |
| 131 ;; coding system just in case. | |
| 132 (Assert (not (buffer-modified-p))) | |
| 133 (kill-buffer nil) | |
| 134 (when (find-coding-system 'utf-8) | |
| 135 (find-file test-file-name 'utf-8) | |
| 136 (insert "more text\n") | |
| 137 (revert-buffer t t) | |
| 138 (Assert (not (buffer-modified-p))) | |
| 139 (kill-buffer nil)) | |
| 140 (delete-file test-file-name)) | |
| 141 | |
|
4647
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
142 (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
|
143 (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
|
144 (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
|
145 (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
|
146 (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
|
147 (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
|
148 (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
|
149 (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
|
150 (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
|
151 (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
|
152 (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
|
153 (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
|
154 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
|
155 (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
|
156 (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
|
157 (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
|
158 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
|
159 (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
|
160 (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
|
161 (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
|
162 |
| 434 | 163 ;;----------------------------------------------------------------- |
| 164 ;; Test string modification functions that modify the length of a char. | |
| 165 ;;----------------------------------------------------------------- | |
| 166 | |
| 167 (when (featurep 'mule) | |
| 442 | 168 ;;--------------------------------------------------------------- |
| 434 | 169 ;; Test fillarray |
| 442 | 170 ;;--------------------------------------------------------------- |
| 434 | 171 (macrolet |
| 172 ((fillarray-test | |
| 173 (charset1 charset2) | |
| 174 (let ((char1 (make-char charset1 69)) | |
| 175 (char2 (make-char charset2 69))) | |
| 176 `(let ((string (make-string 1000 ,char1))) | |
| 177 (fillarray string ,char2) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
178 (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
|
179 (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
|
180 (Assert (eq (length string) 1000)))))) |
| 434 | 181 (fillarray-test ascii latin-iso8859-1) |
| 182 (fillarray-test ascii latin-iso8859-2) | |
| 183 (fillarray-test latin-iso8859-1 ascii) | |
| 184 (fillarray-test latin-iso8859-2 ascii)) | |
| 185 | |
| 186 ;; Test aset | |
| 187 (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69)))) | |
| 188 (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
|
189 (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69)))) |
| 434 | 190 |
| 442 | 191 ;;--------------------------------------------------------------- |
| 440 | 192 ;; Test coding system functions |
| 442 | 193 ;;--------------------------------------------------------------- |
| 440 | 194 |
| 195 ;; Create alias for coding system without subsidiaries | |
| 196 (Assert (coding-system-p (find-coding-system 'binary))) | |
| 197 (Assert (coding-system-canonical-name-p 'binary)) | |
| 198 (Assert (not (coding-system-alias-p 'binary))) | |
| 199 (Assert (not (coding-system-alias-p 'mule-tests-alias))) | |
| 200 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 201 (Check-Error-Message | |
| 202 error "Symbol is the canonical name of a coding system and cannot be redefined" | |
| 203 (define-coding-system-alias 'binary 'iso8859-2)) | |
| 204 (Check-Error-Message | |
| 205 error "Symbol is not a coding system alias" | |
| 206 (coding-system-aliasee 'binary)) | |
| 207 | |
| 208 (define-coding-system-alias 'mule-tests-alias 'binary) | |
| 209 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 210 (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
|
211 (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
|
212 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) |
| 440 | 213 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) |
| 214 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) | |
| 215 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) | |
| 216 | |
| 217 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary)) | |
| 218 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 219 (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
|
220 (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
|
221 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) |
| 440 | 222 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) |
| 223 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) | |
| 224 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) | |
| 225 | |
| 226 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) | |
| 227 (Assert (coding-system-alias-p 'nested-mule-tests-alias)) | |
| 228 (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
|
229 (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
|
230 (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
|
231 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) |
| 440 | 232 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix))) |
| 233 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) | |
| 234 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac))) | |
| 235 | |
| 236 (Check-Error-Message | |
| 237 error "Attempt to create a coding system alias loop" | |
| 238 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias)) | |
| 239 (Check-Error-Message | |
| 240 error "No such coding system" | |
| 241 (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system)) | |
| 242 (Check-Error-Message | |
| 243 error "Attempt to create a coding system alias loop" | |
| 244 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias)) | |
| 245 | |
| 246 (define-coding-system-alias 'nested-mule-tests-alias nil) | |
| 247 (define-coding-system-alias 'mule-tests-alias nil) | |
| 248 (Assert (coding-system-p (find-coding-system 'binary))) | |
| 249 (Assert (coding-system-canonical-name-p 'binary)) | |
| 250 (Assert (not (coding-system-alias-p 'binary))) | |
| 251 (Assert (not (coding-system-alias-p 'mule-tests-alias))) | |
| 252 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 253 (Check-Error-Message | |
| 254 error "Symbol is the canonical name of a coding system and cannot be redefined" | |
| 255 (define-coding-system-alias 'binary 'iso8859-2)) | |
| 256 (Check-Error-Message | |
| 257 error "Symbol is not a coding system alias" | |
| 258 (coding-system-aliasee 'binary)) | |
| 259 | |
| 260 (define-coding-system-alias 'nested-mule-tests-alias nil) | |
| 261 (define-coding-system-alias 'mule-tests-alias nil) | |
| 262 | |
| 263 ;; Create alias for coding system with subsidiaries | |
| 264 (define-coding-system-alias 'mule-tests-alias 'iso-8859-7) | |
| 265 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 266 (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
|
267 (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
|
268 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) |
| 440 | 269 (Assert (coding-system-alias-p 'mule-tests-alias-unix)) |
| 270 (Assert (coding-system-alias-p 'mule-tests-alias-dos)) | |
| 271 (Assert (coding-system-alias-p 'mule-tests-alias-mac)) | |
| 272 | |
| 273 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'iso-8859-7)) | |
| 274 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 275 (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
|
276 (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
|
277 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) |
| 440 | 278 (Assert (coding-system-alias-p 'mule-tests-alias-unix)) |
| 279 (Assert (coding-system-alias-p 'mule-tests-alias-dos)) | |
| 280 (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
|
281 (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
|
282 (find-coding-system 'iso-8859-7-mac))) |
| 440 | 283 |
| 284 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) | |
| 285 (Assert (coding-system-alias-p 'nested-mule-tests-alias)) | |
| 286 (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
|
287 (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
|
288 (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
|
289 (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
|
290 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) |
| 440 | 291 (Assert (coding-system-alias-p 'nested-mule-tests-alias-unix)) |
| 292 (Assert (coding-system-alias-p 'nested-mule-tests-alias-dos)) | |
| 293 (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
|
294 (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
|
295 (find-coding-system 'iso-8859-7-unix))) |
| 440 | 296 |
| 297 (Check-Error-Message | |
| 298 error "Attempt to create a coding system alias loop" | |
| 299 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias)) | |
| 300 (Check-Error-Message | |
| 301 error "No such coding system" | |
| 302 (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system)) | |
| 303 (Check-Error-Message | |
| 304 error "Attempt to create a coding system alias loop" | |
| 305 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias)) | |
| 306 | |
| 307 ;; Test dangling alias deletion | |
| 308 (define-coding-system-alias 'mule-tests-alias nil) | |
| 309 (Assert (not (coding-system-alias-p 'mule-tests-alias))) | |
| 310 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) | |
| 311 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias))) | |
| 312 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) | |
| 313 | |
| 442 | 314 ;;--------------------------------------------------------------- |
| 438 | 315 ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c) |
| 442 | 316 ;;--------------------------------------------------------------- |
| 438 | 317 (defun charset-char-string (charset) |
| 2026 | 318 (let (lo hi string n (gc-cons-threshold most-positive-fixnum)) |
| 438 | 319 (if (= (charset-chars charset) 94) |
| 320 (setq lo 33 hi 126) | |
| 321 (setq lo 32 hi 127)) | |
| 322 (if (= (charset-dimension charset) 1) | |
| 323 (progn | |
| 324 (setq string (make-string (1+ (- hi lo)) ??)) | |
| 325 (setq n 0) | |
| 326 (loop for j from lo to hi do | |
| 327 (progn | |
| 328 (aset string n (make-char charset j)) | |
| 329 (incf n))) | |
| 2026 | 330 (garbage-collect) |
| 438 | 331 string) |
| 332 (progn | |
| 333 (setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??)) | |
| 334 (setq n 0) | |
| 335 (loop for j from lo to hi do | |
| 336 (loop for k from lo to hi do | |
| 337 (progn | |
| 338 (aset string n (make-char charset j k)) | |
| 339 (incf n)))) | |
| 2026 | 340 (garbage-collect) |
| 438 | 341 string)))) |
| 342 | |
| 343 ;; The following two used to crash xemacs! | |
| 344 (Assert (charset-char-string 'japanese-jisx0208)) | |
| 345 (aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 77)) | |
| 346 | |
| 347 (let ((greek-string (charset-char-string 'greek-iso8859-7)) | |
| 348 (string (make-string (* 96 60) ??))) | |
| 349 (loop for j from 0 below (length string) do | |
| 350 (aset string j (aref greek-string (mod j 96)))) | |
| 351 (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
|
352 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) |
| 438 | 353 |
| 354 (let ((greek-string (charset-char-string 'greek-iso8859-7)) | |
| 355 (string (make-string (* 96 60) ??))) | |
| 356 (loop for j from (1- (length string)) downto 0 do | |
| 357 (aset string j (aref greek-string (mod j 96)))) | |
| 358 (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
|
359 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) |
| 438 | 360 |
| 361 (let ((ascii-string (charset-char-string 'ascii)) | |
| 362 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) | |
| 363 (loop for j from 0 below (length string) do | |
| 364 (aset string j (aref ascii-string (mod j 94)))) | |
| 365 (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
|
366 (Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string)))) |
| 438 | 367 |
| 368 (let ((ascii-string (charset-char-string 'ascii)) | |
| 369 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) | |
| 370 (loop for j from (1- (length string)) downto 0 do | |
| 371 (aset string j (aref ascii-string (mod j 94)))) | |
| 372 (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
|
373 (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string)))) |
| 438 | 374 |
| 442 | 375 ;;--------------------------------------------------------------- |
|
5107
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
376 ;; 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
|
377 ;;--------------------------------------------------------------- |
|
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 ;; #### 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
|
380 |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
381 (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
|
382 (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
|
383 (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
|
384 s)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
385 (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
|
386 (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
|
387 (pos 0)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
388 (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
|
389 (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
|
390 (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
|
391 (incf pos)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
392 (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
|
393 (incf pos)) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
394 s))) |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
395 (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
|
396 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
|
397 |
|
ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4957
diff
changeset
|
398 ;;--------------------------------------------------------------- |
| 442 | 399 ;; Test file-system character conversion (and, en passant, file ops) |
| 400 ;;--------------------------------------------------------------- | |
| 3970 | 401 (let* ((dstroke (make-char 'latin-iso8859-2 80)) |
| 402 (latin2-string (make-string 4 dstroke)) | |
| 597 | 403 (prefix (concat (file-name-as-directory |
| 404 (file-truename (temp-directory))) | |
| 405 latin2-string)) | |
| 2026 | 406 (file-name-coding-system |
| 407 ;; 'iso-8859-X doesn't work on darwin (as of "Panther" 10.3), it | |
| 408 ;; 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
|
409 (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
|
410 (featurep 'cygwin-use-utf-8)) |
| 2026 | 411 'utf-8 |
| 412 'iso-8859-2)) | |
| 3970 | 413 ;; make-temp-name does stat(), which on OS X requires that you |
| 414 ;; normalise, where open() will normalise for you. Previously we | |
| 415 ;; used scaron as the Latin-2 character, and make-temp-name errored | |
| 3976 | 416 ;; on OS X. LATIN CAPITAL LETTER D WITH STROKE does not decompose. |
| 3970 | 417 (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
|
418 (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
|
419 (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
|
420 working-symlinks) |
| 3472 | 421 (Assert (not (equal name1 name2))) |
| 422 (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
|
423 ;; This is how you suppress output from `message', called by `write-region' |
| 3472 | 424 (Silence-Message |
| 425 (write-region (point-min) (point-max) name1)) | |
| 426 (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
|
427 (Silence-Message |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
428 (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
|
429 (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
|
430 (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
|
431 (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
|
432 (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
|
433 ;; 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
|
434 ;; 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
|
435 (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
|
436 (when working-symlinks |
| 3472 | 437 (make-symbolic-link name1 name2) |
| 438 (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
|
439 (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
|
440 (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
|
441 (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
|
442 (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
|
443 (ignore-file-errors (delete-file name3))) |
| 442 | 444 |
| 445 ;; Add many more file operation tests here... | |
| 446 | |
| 447 ;;--------------------------------------------------------------- | |
| 448 ;; Test Unicode-related functions | |
| 449 ;;--------------------------------------------------------------- | |
| 4861 | 450 (let* ((scaron (make-char 'latin-iso8859-2 57))) |
| 875 | 451 ;; 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
|
452 (loop |
|
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
453 for code in '(#x0100 #x2222 #x4444 #xffff) |
| 4861 | 454 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
|
455 do |
| 442 | 456 (progn |
| 4861 | 457 (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
|
458 (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
|
459 (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2))))) |
| 4861 | 460 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
|
461 (Check-Error args-out-of-range (set-unicode-conversion scaron -10000))) |
| 1195 | 462 |
| 3439 | 463 (dolist (utf-8-char |
| 464 '("\xc6\x92" ;; U+0192 LATIN SMALL LETTER F WITH HOOK | |
| 465 "\xe2\x81\x8a" ;; U+204A TIRONIAN SIGN ET | |
| 466 "\xe2\x82\xae" ;; U+20AE TUGRIK SIGN | |
| 467 "\xf0\x9d\x92\xbd" ;; U+1D4BD MATHEMATICAL SCRIPT SMALL H | |
| 468 "\xf0\x9d\x96\x93" ;; U+1D593 MATHEMATICAL BOLD FRAKTUR SMALL N | |
| 469 "\xf0\xaf\xa8\x88" ;; U+2FA08 CJK COMPATIBILITY FOR U+4BCE | |
| 470 "\xf4\x8f\xbf\xbd")) ;; U+10FFFD <Plane 16 Private Use, Last> | |
| 471 (let* ((xemacs-character (car (append | |
| 472 (decode-coding-string utf-8-char 'utf-8) | |
| 473 nil))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
474 (xemacs-charset (car (split-char xemacs-character)))) |
| 3439 | 475 |
| 476 ;; 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
|
477 (Assert (equal (decode-coding-string utf-8-char 'utf-8) |
| 3439 | 478 (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
|
479 'escape-quoted))) |
| 3439 | 480 |
| 481 ;; 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
|
482 (Assert (equal (unicode-code-point-to-utf-8-string |
| 3439 | 483 (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
|
484 utf-8-char)) |
| 3439 | 485 |
| 486 ;; Check that, if this character has been JIT-allocated, it is encoded | |
| 487 ;; in escape-quoted using the corresponding UTF-8 escape. | |
| 488 (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
|
489 (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
|
490 (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
|
491 (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
|
492 (encode-coding-string xemacs-character 'ctext)))))) |
| 3439 | 493 |
| 3952 | 494 (loop |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
495 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
|
496 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
|
497 (#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
|
498 do |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
499 (Assert (equal (encode-coding-string |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
500 (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
|
501 utf-16-big-endian)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
502 (Assert (equal (encode-coding-string |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
503 (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
|
504 utf-16-little-endian))) |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
505 |
| 3952 | 506 |
| 1195 | 507 ;;--------------------------------------------------------------- |
| 3690 | 508 ;; Regression test for a couple of CCL-related bugs. |
| 509 ;;--------------------------------------------------------------- | |
| 510 | |
| 511 (let ((ccl-vector [0 0 0 0 0 0 0 0 0])) | |
| 512 (define-ccl-program ccl-write-two-control-1-chars | |
| 513 `(1 | |
| 514 ((r0 = ,(charset-id 'control-1)) | |
| 515 (r1 = 0) | |
| 516 (write-multibyte-character r0 r1) | |
| 517 (r1 = 31) | |
| 518 (write-multibyte-character r0 r1))) | |
| 519 "CCL program that writes two control-1 multibyte characters.") | |
| 520 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
521 (Assert (equal |
| 3690 | 522 (ccl-execute-on-string 'ccl-write-two-control-1-chars |
| 523 ccl-vector "") | |
| 524 (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
|
525 (make-char 'control-1 31)))) |
| 3690 | 526 |
| 527 (define-ccl-program ccl-unicode-two-control-1-chars | |
| 528 `(1 | |
| 529 ((r0 = ,(charset-id 'control-1)) | |
| 530 (r1 = 31) | |
| 531 (mule-to-unicode r0 r1) | |
| 532 (r4 = r0) | |
| 533 (r3 = ,(charset-id 'control-1)) | |
| 534 (r2 = 0) | |
| 535 (mule-to-unicode r3 r2))) | |
| 536 "CCL program that writes two control-1 UCS code points in r3 and r4") | |
| 537 | |
| 538 ;; Re-initialise the vector, mainly to clear the instruction counter, | |
| 539 ;; which is its last element. | |
| 540 (setq ccl-vector [0 0 0 0 0 0 0 0 0]) | |
| 541 | |
| 542 (ccl-execute-on-string 'ccl-unicode-two-control-1-chars ccl-vector "") | |
| 543 | |
| 544 (Assert (and (eq (aref ccl-vector 3) | |
| 545 (encode-char (make-char 'control-1 0) 'ucs)) | |
| 546 (eq (aref ccl-vector 4) | |
| 547 (encode-char (make-char 'control-1 31) 'ucs))))) | |
| 548 | |
| 4295 | 549 |
| 550 ;; Test the 8 bit fixed-width coding systems for round-trip | |
| 551 ;; compatibility with themselves. | |
| 552 (loop | |
| 553 for coding-system in (coding-system-list) | |
| 554 with all-possible-octets = (apply #'string | |
| 555 (loop for i from ?\x00 to ?\xFF | |
| 556 collect i)) | |
| 557 do | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4688
diff
changeset
|
558 (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
|
559 ;; 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
|
560 ;; (maybe we should): |
|
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
561 (eq 'lf (coding-system-eol-type coding-system))) |
| 4295 | 562 ;; 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
|
563 (Assert (equal (encode-coding-string |
| 4295 | 564 (decode-coding-string all-possible-octets |
| 565 coding-system) | |
| 566 coding-system) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
567 all-possible-octets) |
|
4715
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
568 (format "checking %s is transparent" coding-system)))) |
| 4295 | 569 |
| 3690 | 570 ;;--------------------------------------------------------------- |
| 1195 | 571 ;; Test charset-in-* functions |
| 572 ;;--------------------------------------------------------------- | |
| 573 (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
|
574 (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
|
575 '(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
|
576 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
|
577 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
|
578 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
|
579 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
|
580 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
|
581 (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
|
582 (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
|
583 (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
|
584 ;; 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
|
585 ;; irrelevant. |
|
5530
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
586 (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
|
587 (point-max)) |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
588 :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
|
589 #'string<) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
590 sorted-charsets-in-HELLO)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
591 (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
|
592 (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
|
593 (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
|
594 (point-max))) |
|
17bcc2aab111
Update the GPLv3 HELLO to use the ISO-IR-196 escape sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
595 :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
|
596 #'string<) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5107
diff
changeset
|
597 sorted-charsets-in-HELLO)))) |
| 3948 | 598 |
| 4133 | 599 ;;--------------------------------------------------------------- |
| 600 ;; Language environments, and whether the specified values are sane. | |
| 601 ;;--------------------------------------------------------------- | |
| 602 (loop | |
| 603 for language in (mapcar #'car language-info-alist) | |
| 604 with language-input-method = nil | |
| 4305 | 605 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
|
606 with original-language-environment = current-language-environment |
| 4133 | 607 do |
| 608 ;; s-l-e can call #'require, which says "Loading ..." | |
| 609 (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
|
610 (Assert (equal language current-language-environment)) |
| 4133 | 611 |
| 612 (setq language-input-method | |
| 613 (get-language-info language 'input-method)) | |
| 614 (when (and language-input-method | |
| 615 ;; #### Not robust, if more input methods besides canna are | |
| 616 ;; in core. The intention of this is that if *any* of the | |
| 617 ;; packages' input methods are available, we check that *all* | |
| 618 ;; of the language environments' input methods actually | |
| 619 ;; exist, which goes against the spirit of non-monolithic | |
| 620 ;; packages. But I don't have a better approach to this. | |
| 621 (> (length input-method-alist) 1)) | |
| 622 (Assert (assoc language-input-method input-method-alist)) | |
| 623 (Skip-Test-Unless | |
| 624 (assoc language-input-method input-method-alist) | |
| 625 "input method unavailable" | |
| 626 (format "check that IM %s can be activated" language-input-method) | |
| 627 ;; s-i-m can load files. | |
| 628 (Silence-Message | |
| 629 (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
|
630 (Assert (equal language-input-method current-input-method)))) |
| 4133 | 631 |
| 3970 | 632 (dolist (charset (get-language-info language 'charset)) |
| 633 (Assert (charsetp (find-charset charset)))) | |
| 634 (dolist (coding-system (get-language-info language 'coding-system)) | |
| 635 (Assert (coding-system-p (find-coding-system coding-system)))) | |
| 4305 | 636 (dolist (coding-system |
| 637 (if (listp (setq native-coding-system | |
| 638 (get-language-info language | |
| 639 'native-coding-system))) | |
| 640 native-coding-system | |
| 641 (list native-coding-system))) | |
| 4133 | 642 ;; We don't have the appropriate POSIX locales to test with a |
| 643 ;; native-coding-system that is a function. | |
| 644 (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
|
645 (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
|
646 finally (set-language-environment original-language-environment)) |
| 3970 | 647 |
| 3948 | 648 (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
|
649 (labels |
| 3948 | 650 ((Assert-elc-is-escape-quoted () |
| 651 "Assert the current buffer has an escape-quoted cookie if compiled." | |
| 652 (save-excursion | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
653 (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
|
654 (expand-file-name "zjPQ2Pk" |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
655 (temp-directory)))) |
|
5595
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
656 (byte-compile-result |
|
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
657 (Silence-Message (byte-compile-from-buffer |
|
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
658 (current-buffer) temporary-file-name |
|
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
659 nil)))) |
| 4133 | 660 (Assert (string-match |
| 661 "^;;;###coding system: escape-quoted" | |
| 662 (buffer-substring nil nil byte-compile-result)))))) | |
|
5595
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
663 (Assert-elc-is-raw-text-unix () |
| 3948 | 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)))) |
|
5595
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
669 (byte-compile-result |
|
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
670 (Silence-Message |
|
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
671 (byte-compile-from-buffer (current-buffer) |
|
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
672 temporary-file-name nil)))) |
|
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
673 (Assert (string-match |
|
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
674 "^;;;###coding system: raw-text-unix" |
|
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
675 (buffer-substring nil nil 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 | |
|
5595
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
733 (Assert-elc-is-raw-text-unix) |
| 4133 | 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 |
|
5595
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
741 (Assert-elc-is-raw-text-unix) |
| 3948 | 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 |
|
5595
391d809fa4e9
Update tests that have started failing because of changed design decisions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5576
diff
changeset
|
749 (Assert-elc-is-raw-text-unix) |
| 3948 | 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)))) |
|
5664
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
810 ;;; Test suite for truncate-string-to-width, from Colin Walters' tests in |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
811 ;;; mult-util.el in GNU. |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
812 (macrolet |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
813 ((test-truncate-string-to-width (&rest tests) |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
814 (let ((decode-any-string |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
815 ;; We can't store the East Asian characters directly in this |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
816 ;; file, since it needs to be read (but not executed) by |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
817 ;; non-Mule. Store them as UTF-8, decode them at |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
818 ;; macro-expansion time. |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
819 #'(lambda (object) |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
820 (if (stringp object) |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
821 (decode-coding-string object 'utf-8) |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
822 object)))) |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
823 (cons |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
824 'progn |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
825 (mapcar |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
826 (function* |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
827 (lambda ((arguments . result)) |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
828 `(Assert (equal (truncate-string-to-width |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
829 ,@(mapcar decode-any-string arguments)) |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
830 ,(funcall decode-any-string result))))) |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
831 tests))))) |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
832 (test-truncate-string-to-width |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
833 (("" 0) . "") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
834 (("x" 1) . "x") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
835 (("xy" 1) . "x") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
836 (("xy" 2 1) . "y") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
837 (("xy" 0) . "") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
838 (("xy" 3) . "xy") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
839 (("\344\270\255" 0) . "") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
840 (("\344\270\255" 1) . "") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
841 (("\344\270\255" 2) . "\344\270\255") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
842 (("\344\270\255" 1 nil ? ) . " ") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
843 (("\344\270\255\346\226\207" 3 1 ? ) . " ") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
844 (("x\344\270\255x" 2) . "x") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
845 (("x\344\270\255x" 3) . "x\344\270\255") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
846 (("x\344\270\255x" 3) . "x\344\270\255") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
847 (("x\344\270\255x" 4 1) . "\344\270\255x") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
848 (("kor\355\225\234e\352\270\200an" 8 1 ? ) . |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
849 "or\355\225\234e\352\270\200") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
850 (("kor\355\225\234e\352\270\200an" 7 2 ? ) . "r\355\225\234e ") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
851 (("" 0 nil nil "...") . "") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
852 (("x" 3 nil nil "...") . "x") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
853 (("\344\270\255" 3 nil nil "...") . "\344\270\255") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
854 (("foo" 3 nil nil "...") . "foo") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
855 (("foo" 2 nil nil "...") . "fo") ;; (old) XEmacs failure? |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
856 (("foobar" 6 0 nil "...") . "foobar") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
857 (("foobarbaz" 6 nil nil "...") . "foo...") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
858 (("foobarbaz" 7 2 nil "...") . "ob...") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
859 (("foobarbaz" 9 3 nil "...") . "barbaz") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
860 (("\343\201\223h\343\202\223e\343\201\253l\343\201\241l\343\201\257o" 15 |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
861 1 ? t) . " h\343\202\223e\343\201\253l\343\201\241l\343\201\257o") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
862 (("\343\201\223h\343\202\223e\343\201\253l\343\201\241l\343\201\257o" 14 |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
863 1 ? t) . " h\343\202\223e\343\201\253l\343\201\241...") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
864 (("x" 3 nil nil "\347\262\265\350\252\236") . "x") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
865 (("\344\270\255" 2 nil nil "\347\262\265\350\252\236") . "\344\270\255") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
866 ;; XEmacs used to error |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
867 (("\344\270\255" 1 nil ?x "\347\262\265\350\252\236") . "x") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
868 (("\344\270\255\346\226\207" 3 nil ? "\347\262\265\350\252\236") . |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
869 ;; XEmacs used to error |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
870 "\344\270\255 ") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
871 (("foobarbaz" 4 nil nil "\347\262\265\350\252\236") . |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
872 "\347\262\265\350\252\236") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
873 (("foobarbaz" 5 nil nil "\347\262\265\350\252\236") . |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
874 "f\347\262\265\350\252\236") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
875 (("foobarbaz" 6 nil nil "\347\262\265\350\252\236") . |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
876 "fo\347\262\265\350\252\236") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
877 (("foobarbaz" 8 3 nil "\347\262\265\350\252\236") . |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
878 "b\347\262\265\350\252\236") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
879 (("\343\201\223h\343\202\223e\343\201\253l\343\201\241l\343\201\257o" 14 |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
880 4 ?x "\346\227\245\346\234\254\350\252\236") . |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
881 "xe\343\201\253\346\227\245\346\234\254\350\252\236") |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
882 (("\343\201\223h\343\202\223e\343\201\253l\343\201\241l\343\201\257o" 13 |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
883 4 ?x "\346\227\245\346\234\254\350\252\236") . |
|
00fd55d635fb
Sync #'truncate-string-to-width with GNU, add tests for it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5595
diff
changeset
|
884 "xex\346\227\245\346\234\254\350\252\236"))) |
|
4731
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
885 ) ; 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
|
886 |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
887 ;;; end of mule-tests.el |