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