Mercurial > hg > xemacs-beta
annotate tests/automated/mule-tests.el @ 4614:afbfad080ddd
The URLs in our current config.guess and config.sub files are obsolete.
Update to the latest upstream release to get correct URLs, as well as fixes
and enhancements to those scripts.
| author | Jerry James <james@xemacs.org> |
|---|---|
| date | Wed, 11 Feb 2009 11:09:35 -0700 |
| parents | 2669b1b7e33b |
| children | 4dc42d1fe684 |
| 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 | |
| 434 | 144 ;;----------------------------------------------------------------- |
| 145 ;; Test string modification functions that modify the length of a char. | |
| 146 ;;----------------------------------------------------------------- | |
| 147 | |
| 148 (when (featurep 'mule) | |
| 442 | 149 ;;--------------------------------------------------------------- |
| 434 | 150 ;; Test fillarray |
| 442 | 151 ;;--------------------------------------------------------------- |
| 434 | 152 (macrolet |
| 153 ((fillarray-test | |
| 154 (charset1 charset2) | |
| 155 (let ((char1 (make-char charset1 69)) | |
| 156 (char2 (make-char charset2 69))) | |
| 157 `(let ((string (make-string 1000 ,char1))) | |
| 158 (fillarray string ,char2) | |
| 159 (Assert (eq (aref string 0) ,char2)) | |
| 160 (Assert (eq (aref string (1- (length string))) ,char2)) | |
| 161 (Assert (eq (length string) 1000)))))) | |
| 162 (fillarray-test ascii latin-iso8859-1) | |
| 163 (fillarray-test ascii latin-iso8859-2) | |
| 164 (fillarray-test latin-iso8859-1 ascii) | |
| 165 (fillarray-test latin-iso8859-2 ascii)) | |
| 166 | |
| 167 ;; Test aset | |
| 168 (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69)))) | |
| 169 (aset string 0 (make-char 'latin-iso8859-2 42)) | |
| 170 (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69)))) | |
| 171 | |
| 442 | 172 ;;--------------------------------------------------------------- |
| 440 | 173 ;; Test coding system functions |
| 442 | 174 ;;--------------------------------------------------------------- |
| 440 | 175 |
| 176 ;; Create alias for coding system without subsidiaries | |
| 177 (Assert (coding-system-p (find-coding-system 'binary))) | |
| 178 (Assert (coding-system-canonical-name-p 'binary)) | |
| 179 (Assert (not (coding-system-alias-p 'binary))) | |
| 180 (Assert (not (coding-system-alias-p 'mule-tests-alias))) | |
| 181 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 182 (Check-Error-Message | |
| 183 error "Symbol is the canonical name of a coding system and cannot be redefined" | |
| 184 (define-coding-system-alias 'binary 'iso8859-2)) | |
| 185 (Check-Error-Message | |
| 186 error "Symbol is not a coding system alias" | |
| 187 (coding-system-aliasee 'binary)) | |
| 188 | |
| 189 (define-coding-system-alias 'mule-tests-alias 'binary) | |
| 190 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 191 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 192 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))) | |
| 193 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) | |
| 194 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) | |
| 195 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) | |
| 196 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) | |
| 197 | |
| 198 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary)) | |
| 199 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 200 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 201 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))) | |
| 202 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) | |
| 203 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) | |
| 204 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) | |
| 205 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) | |
| 206 | |
| 207 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) | |
| 208 (Assert (coding-system-alias-p 'nested-mule-tests-alias)) | |
| 209 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) | |
| 210 (Assert (eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias))) | |
| 211 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias)) | |
| 212 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) | |
| 213 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix))) | |
| 214 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) | |
| 215 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac))) | |
| 216 | |
| 217 (Check-Error-Message | |
| 218 error "Attempt to create a coding system alias loop" | |
| 219 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias)) | |
| 220 (Check-Error-Message | |
| 221 error "No such coding system" | |
| 222 (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system)) | |
| 223 (Check-Error-Message | |
| 224 error "Attempt to create a coding system alias loop" | |
| 225 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias)) | |
| 226 | |
| 227 (define-coding-system-alias 'nested-mule-tests-alias nil) | |
| 228 (define-coding-system-alias 'mule-tests-alias nil) | |
| 229 (Assert (coding-system-p (find-coding-system 'binary))) | |
| 230 (Assert (coding-system-canonical-name-p 'binary)) | |
| 231 (Assert (not (coding-system-alias-p 'binary))) | |
| 232 (Assert (not (coding-system-alias-p 'mule-tests-alias))) | |
| 233 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 234 (Check-Error-Message | |
| 235 error "Symbol is the canonical name of a coding system and cannot be redefined" | |
| 236 (define-coding-system-alias 'binary 'iso8859-2)) | |
| 237 (Check-Error-Message | |
| 238 error "Symbol is not a coding system alias" | |
| 239 (coding-system-aliasee 'binary)) | |
| 240 | |
| 241 (define-coding-system-alias 'nested-mule-tests-alias nil) | |
| 242 (define-coding-system-alias 'mule-tests-alias nil) | |
| 243 | |
| 244 ;; Create alias for coding system with subsidiaries | |
| 245 (define-coding-system-alias 'mule-tests-alias 'iso-8859-7) | |
| 246 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 247 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 248 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))) | |
| 249 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) | |
| 250 (Assert (coding-system-alias-p 'mule-tests-alias-unix)) | |
| 251 (Assert (coding-system-alias-p 'mule-tests-alias-dos)) | |
| 252 (Assert (coding-system-alias-p 'mule-tests-alias-mac)) | |
| 253 | |
| 254 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'iso-8859-7)) | |
| 255 (Assert (coding-system-alias-p 'mule-tests-alias)) | |
| 256 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) | |
| 257 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))) | |
| 258 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) | |
| 259 (Assert (coding-system-alias-p 'mule-tests-alias-unix)) | |
| 260 (Assert (coding-system-alias-p 'mule-tests-alias-dos)) | |
| 261 (Assert (coding-system-alias-p 'mule-tests-alias-mac)) | |
| 262 (Assert (eq (find-coding-system 'mule-tests-alias-mac) | |
| 263 (find-coding-system 'iso-8859-7-mac))) | |
| 264 | |
| 265 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) | |
| 266 (Assert (coding-system-alias-p 'nested-mule-tests-alias)) | |
| 267 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) | |
| 268 (Assert (eq (get-coding-system 'iso-8859-7) | |
| 269 (get-coding-system 'nested-mule-tests-alias))) | |
| 270 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias)) | |
| 271 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) | |
| 272 (Assert (coding-system-alias-p 'nested-mule-tests-alias-unix)) | |
| 273 (Assert (coding-system-alias-p 'nested-mule-tests-alias-dos)) | |
| 274 (Assert (coding-system-alias-p 'nested-mule-tests-alias-mac)) | |
| 275 (Assert (eq (find-coding-system 'nested-mule-tests-alias-unix) | |
| 276 (find-coding-system 'iso-8859-7-unix))) | |
| 277 | |
| 278 (Check-Error-Message | |
| 279 error "Attempt to create a coding system alias loop" | |
| 280 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias)) | |
| 281 (Check-Error-Message | |
| 282 error "No such coding system" | |
| 283 (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system)) | |
| 284 (Check-Error-Message | |
| 285 error "Attempt to create a coding system alias loop" | |
| 286 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias)) | |
| 287 | |
| 288 ;; Test dangling alias deletion | |
| 289 (define-coding-system-alias 'mule-tests-alias nil) | |
| 290 (Assert (not (coding-system-alias-p 'mule-tests-alias))) | |
| 291 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) | |
| 292 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias))) | |
| 293 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) | |
| 294 | |
| 442 | 295 ;;--------------------------------------------------------------- |
| 438 | 296 ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c) |
| 442 | 297 ;;--------------------------------------------------------------- |
| 438 | 298 (defun charset-char-string (charset) |
| 2026 | 299 (let (lo hi string n (gc-cons-threshold most-positive-fixnum)) |
| 438 | 300 (if (= (charset-chars charset) 94) |
| 301 (setq lo 33 hi 126) | |
| 302 (setq lo 32 hi 127)) | |
| 303 (if (= (charset-dimension charset) 1) | |
| 304 (progn | |
| 305 (setq string (make-string (1+ (- hi lo)) ??)) | |
| 306 (setq n 0) | |
| 307 (loop for j from lo to hi do | |
| 308 (progn | |
| 309 (aset string n (make-char charset j)) | |
| 310 (incf n))) | |
| 2026 | 311 (garbage-collect) |
| 438 | 312 string) |
| 313 (progn | |
| 314 (setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??)) | |
| 315 (setq n 0) | |
| 316 (loop for j from lo to hi do | |
| 317 (loop for k from lo to hi do | |
| 318 (progn | |
| 319 (aset string n (make-char charset j k)) | |
| 320 (incf n)))) | |
| 2026 | 321 (garbage-collect) |
| 438 | 322 string)))) |
| 323 | |
| 324 ;; The following two used to crash xemacs! | |
| 325 (Assert (charset-char-string 'japanese-jisx0208)) | |
| 326 (aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 77)) | |
| 327 | |
| 328 (let ((greek-string (charset-char-string 'greek-iso8859-7)) | |
| 329 (string (make-string (* 96 60) ??))) | |
| 330 (loop for j from 0 below (length string) do | |
| 331 (aset string j (aref greek-string (mod j 96)))) | |
| 332 (loop for k in '(0 1 58 59) do | |
| 333 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) | |
| 334 | |
| 335 (let ((greek-string (charset-char-string 'greek-iso8859-7)) | |
| 336 (string (make-string (* 96 60) ??))) | |
| 337 (loop for j from (1- (length string)) downto 0 do | |
| 338 (aset string j (aref greek-string (mod j 96)))) | |
| 339 (loop for k in '(0 1 58 59) do | |
| 340 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) | |
| 341 | |
| 342 (let ((ascii-string (charset-char-string 'ascii)) | |
| 343 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) | |
| 344 (loop for j from 0 below (length string) do | |
| 345 (aset string j (aref ascii-string (mod j 94)))) | |
| 346 (loop for k in '(0 1 58 59) do | |
| 347 (Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string)))) | |
| 348 | |
| 349 (let ((ascii-string (charset-char-string 'ascii)) | |
| 350 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) | |
| 351 (loop for j from (1- (length string)) downto 0 do | |
| 352 (aset string j (aref ascii-string (mod j 94)))) | |
| 353 (loop for k in '(0 1 58 59) do | |
| 354 (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string)))) | |
| 355 | |
| 442 | 356 ;;--------------------------------------------------------------- |
| 357 ;; Test file-system character conversion (and, en passant, file ops) | |
| 358 ;;--------------------------------------------------------------- | |
| 3970 | 359 (let* ((dstroke (make-char 'latin-iso8859-2 80)) |
| 360 (latin2-string (make-string 4 dstroke)) | |
| 597 | 361 (prefix (concat (file-name-as-directory |
| 362 (file-truename (temp-directory))) | |
| 363 latin2-string)) | |
| 2026 | 364 (file-name-coding-system |
| 365 ;; 'iso-8859-X doesn't work on darwin (as of "Panther" 10.3), it | |
| 366 ;; seems to know that file-name-coding-system is definitely utf-8 | |
| 367 (if (string-match "darwin" system-configuration) | |
| 368 'utf-8 | |
| 369 'iso-8859-2)) | |
| 3970 | 370 ;; make-temp-name does stat(), which on OS X requires that you |
| 371 ;; normalise, where open() will normalise for you. Previously we | |
| 372 ;; used scaron as the Latin-2 character, and make-temp-name errored | |
| 3976 | 373 ;; on OS X. LATIN CAPITAL LETTER D WITH STROKE does not decompose. |
| 3970 | 374 (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
|
375 (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
|
376 (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
|
377 working-symlinks) |
| 3472 | 378 (Assert (not (equal name1 name2))) |
| 379 (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
|
380 ;; This is how you suppress output from `message', called by `write-region' |
| 3472 | 381 (Silence-Message |
| 382 (write-region (point-min) (point-max) name1)) | |
| 383 (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
|
384 (Silence-Message |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
385 (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
|
386 (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
|
387 (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
|
388 (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
|
389 (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
|
390 ;; 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
|
391 ;; 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
|
392 (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
|
393 (when working-symlinks |
| 3472 | 394 (make-symbolic-link name1 name2) |
| 395 (Assert (file-exists-p name2)) | |
| 396 (Assert (equal (file-truename name2) name1)) | |
| 397 (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
|
398 (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
|
399 (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
|
400 (ignore-file-errors (delete-file name3))) |
| 442 | 401 |
| 402 ;; Add many more file operation tests here... | |
| 403 | |
| 404 ;;--------------------------------------------------------------- | |
| 405 ;; Test Unicode-related functions | |
| 406 ;;--------------------------------------------------------------- | |
| 407 (let* ((scaron (make-char 'latin-iso8859-2 57))) | |
| 875 | 408 ;; Used to try #x0000, but you can't change ASCII or Latin-1 |
| 409 (loop for code in '(#x0100 #x2222 #x4444 #xffff) do | |
| 442 | 410 (progn |
| 800 | 411 (set-unicode-conversion scaron code) |
| 412 (Assert (eq code (char-to-unicode scaron))) | |
| 413 (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2)))))) | |
| 442 | 414 |
| 800 | 415 (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000))) |
| 1195 | 416 |
| 3439 | 417 (dolist (utf-8-char |
| 418 '("\xc6\x92" ;; U+0192 LATIN SMALL LETTER F WITH HOOK | |
| 419 "\xe2\x81\x8a" ;; U+204A TIRONIAN SIGN ET | |
| 420 "\xe2\x82\xae" ;; U+20AE TUGRIK SIGN | |
| 421 "\xf0\x9d\x92\xbd" ;; U+1D4BD MATHEMATICAL SCRIPT SMALL H | |
| 422 "\xf0\x9d\x96\x93" ;; U+1D593 MATHEMATICAL BOLD FRAKTUR SMALL N | |
| 423 "\xf0\xaf\xa8\x88" ;; U+2FA08 CJK COMPATIBILITY FOR U+4BCE | |
| 424 "\xf4\x8f\xbf\xbd")) ;; U+10FFFD <Plane 16 Private Use, Last> | |
| 425 (let* ((xemacs-character (car (append | |
| 426 (decode-coding-string utf-8-char 'utf-8) | |
| 427 nil))) | |
| 428 (xemacs-charset (car (split-char xemacs-character)))) | |
| 429 | |
| 430 ;; Trivial test of the UTF-8 support of the escape-quoted character set. | |
| 431 (Assert (equal (decode-coding-string utf-8-char 'utf-8) | |
| 432 (decode-coding-string (concat "\033%G" utf-8-char) | |
| 433 'escape-quoted))) | |
| 434 | |
| 435 ;; Check that the reverse mapping holds. | |
| 436 (Assert (equal (unicode-code-point-to-utf-8-string | |
| 437 (encode-char xemacs-character 'ucs)) | |
| 438 utf-8-char)) | |
| 439 | |
| 440 ;; Check that, if this character has been JIT-allocated, it is encoded | |
| 441 ;; in escape-quoted using the corresponding UTF-8 escape. | |
| 442 (when (charset-property xemacs-charset 'encode-as-utf-8) | |
| 443 (Assert (equal (concat "\033%G" utf-8-char) | |
| 444 (encode-coding-string xemacs-character 'escape-quoted))) | |
| 445 (Assert (equal (concat "\033%G" utf-8-char) | |
| 446 (encode-coding-string xemacs-character 'ctext)))))) | |
| 447 | |
| 3952 | 448 (loop |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
449 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
|
450 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
|
451 (#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
|
452 do |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
453 (Assert (equal (encode-coding-string |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
454 (decode-char 'ucs code-point) 'utf-16) |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
455 utf-16-big-endian)) |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
456 (Assert (equal (encode-coding-string |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
457 (decode-char 'ucs code-point) 'utf-16-le) |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
458 utf-16-little-endian)) |
|
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
459 |
| 3952 | 460 |
| 1195 | 461 ;;--------------------------------------------------------------- |
| 3690 | 462 ;; Regression test for a couple of CCL-related bugs. |
| 463 ;;--------------------------------------------------------------- | |
| 464 | |
| 465 (let ((ccl-vector [0 0 0 0 0 0 0 0 0])) | |
| 466 (define-ccl-program ccl-write-two-control-1-chars | |
| 467 `(1 | |
| 468 ((r0 = ,(charset-id 'control-1)) | |
| 469 (r1 = 0) | |
| 470 (write-multibyte-character r0 r1) | |
| 471 (r1 = 31) | |
| 472 (write-multibyte-character r0 r1))) | |
| 473 "CCL program that writes two control-1 multibyte characters.") | |
| 474 | |
| 475 (Assert (equal | |
| 476 (ccl-execute-on-string 'ccl-write-two-control-1-chars | |
| 477 ccl-vector "") | |
| 478 (format "%c%c" (make-char 'control-1 0) | |
| 479 (make-char 'control-1 31)))) | |
| 480 | |
| 481 (define-ccl-program ccl-unicode-two-control-1-chars | |
| 482 `(1 | |
| 483 ((r0 = ,(charset-id 'control-1)) | |
| 484 (r1 = 31) | |
| 485 (mule-to-unicode r0 r1) | |
| 486 (r4 = r0) | |
| 487 (r3 = ,(charset-id 'control-1)) | |
| 488 (r2 = 0) | |
| 489 (mule-to-unicode r3 r2))) | |
| 490 "CCL program that writes two control-1 UCS code points in r3 and r4") | |
| 491 | |
| 492 ;; Re-initialise the vector, mainly to clear the instruction counter, | |
| 493 ;; which is its last element. | |
| 494 (setq ccl-vector [0 0 0 0 0 0 0 0 0]) | |
| 495 | |
| 496 (ccl-execute-on-string 'ccl-unicode-two-control-1-chars ccl-vector "") | |
| 497 | |
| 498 (Assert (and (eq (aref ccl-vector 3) | |
| 499 (encode-char (make-char 'control-1 0) 'ucs)) | |
| 500 (eq (aref ccl-vector 4) | |
| 501 (encode-char (make-char 'control-1 31) 'ucs))))) | |
| 502 | |
| 4295 | 503 |
| 504 ;; Test the 8 bit fixed-width coding systems for round-trip | |
| 505 ;; compatibility with themselves. | |
| 506 (loop | |
| 507 for coding-system in (coding-system-list) | |
| 508 with all-possible-octets = (apply #'string | |
| 509 (loop for i from ?\x00 to ?\xFF | |
| 510 collect i)) | |
| 511 do | |
| 512 (when (and (coding-system-get coding-system '8-bit-fixed) | |
| 513 ;; Don't check the coding systems with autodetect, they are | |
| 514 ;; not round-trip compatible for the possible line-ending | |
| 515 ;; characters. | |
| 516 (string-match #r"-\(unix\|dos\|mac\)$" | |
| 517 (symbol-name coding-system))) | |
| 518 ;; These coding systems are round-trip compatible with themselves. | |
| 519 (Assert (equal (encode-coding-string | |
| 520 (decode-coding-string all-possible-octets | |
| 521 coding-system) | |
| 522 coding-system) | |
| 523 all-possible-octets)))) | |
| 524 | |
| 3690 | 525 ;;--------------------------------------------------------------- |
| 1195 | 526 ;; Test charset-in-* functions |
| 527 ;;--------------------------------------------------------------- | |
| 528 (with-temp-buffer | |
| 529 (insert-file-contents (locate-data-file "HELLO")) | |
| 3927 | 530 (Assert (equal |
| 531 ;; The sort is to make the algorithm of charsets-in-region | |
| 532 ;; irrelevant. | |
| 533 (sort (charsets-in-region (point-min) (point-max)) | |
| 4133 | 534 #'string<) |
|
4495
c95c06ee1e9d
Correct a test failure now the XEmacs-specific Arabic charsets are gone.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
535 '(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
|
536 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
|
537 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
|
538 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
|
539 vietnamese-viscii-lower))) |
| 3927 | 540 (Assert (equal |
| 541 (sort (charsets-in-string (buffer-substring (point-min) | |
| 1316 | 542 (point-max))) |
| 4133 | 543 #'string<) |
|
4495
c95c06ee1e9d
Correct a test failure now the XEmacs-specific Arabic charsets are gone.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
544 '(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
|
545 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
|
546 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
|
547 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
|
548 vietnamese-viscii-lower)))) |
| 3948 | 549 |
| 4133 | 550 ;;--------------------------------------------------------------- |
| 551 ;; Language environments, and whether the specified values are sane. | |
| 552 ;;--------------------------------------------------------------- | |
| 553 (loop | |
| 554 for language in (mapcar #'car language-info-alist) | |
| 555 with language-input-method = nil | |
| 4305 | 556 with native-coding-system = nil |
| 4133 | 557 do |
| 558 ;; s-l-e can call #'require, which says "Loading ..." | |
| 559 (Silence-Message (set-language-environment language)) | |
| 3970 | 560 (Assert (equal language current-language-environment)) |
| 4133 | 561 |
| 562 (setq language-input-method | |
| 563 (get-language-info language 'input-method)) | |
| 564 (when (and language-input-method | |
| 565 ;; #### Not robust, if more input methods besides canna are | |
| 566 ;; in core. The intention of this is that if *any* of the | |
| 567 ;; packages' input methods are available, we check that *all* | |
| 568 ;; of the language environments' input methods actually | |
| 569 ;; exist, which goes against the spirit of non-monolithic | |
| 570 ;; packages. But I don't have a better approach to this. | |
| 571 (> (length input-method-alist) 1)) | |
| 572 (Assert (assoc language-input-method input-method-alist)) | |
| 573 (Skip-Test-Unless | |
| 574 (assoc language-input-method input-method-alist) | |
| 575 "input method unavailable" | |
| 576 (format "check that IM %s can be activated" language-input-method) | |
| 577 ;; s-i-m can load files. | |
| 578 (Silence-Message | |
| 579 (set-input-method language-input-method)) | |
| 580 (Assert (equal language-input-method current-input-method)))) | |
| 581 | |
| 3970 | 582 (dolist (charset (get-language-info language 'charset)) |
| 583 (Assert (charsetp (find-charset charset)))) | |
| 584 (dolist (coding-system (get-language-info language 'coding-system)) | |
| 585 (Assert (coding-system-p (find-coding-system coding-system)))) | |
| 4305 | 586 (dolist (coding-system |
| 587 (if (listp (setq native-coding-system | |
| 588 (get-language-info language | |
| 589 'native-coding-system))) | |
| 590 native-coding-system | |
| 591 (list native-coding-system))) | |
| 4133 | 592 ;; We don't have the appropriate POSIX locales to test with a |
| 593 ;; native-coding-system that is a function. | |
| 594 (unless (functionp coding-system) | |
| 595 (Assert (coding-system-p (find-coding-system coding-system)))))) | |
| 3970 | 596 |
| 3948 | 597 (with-temp-buffer |
| 598 (flet | |
| 599 ((Assert-elc-is-escape-quoted () | |
| 600 "Assert the current buffer has an escape-quoted cookie if compiled." | |
| 601 (save-excursion | |
| 602 (let ((byte-compile-result (byte-compile-from-buffer | |
| 603 (current-buffer) nil nil)) | |
| 604 (temporary-file-name (make-temp-name | |
| 605 (expand-file-name "zjPQ2Pk" | |
| 606 (temp-directory))))) | |
| 607 (byte-compile-insert-header | |
| 608 temporary-file-name | |
| 609 (current-buffer) | |
| 610 byte-compile-result) | |
| 4133 | 611 (Assert (string-match |
| 612 "^;;;###coding system: escape-quoted" | |
| 613 (buffer-substring nil nil byte-compile-result)))))) | |
| 3948 | 614 (Assert-elc-has-no-specified-encoding () |
| 615 "Assert the current buffer has no coding cookie if compiled." | |
| 616 (save-excursion | |
| 617 (let ((byte-compile-result (byte-compile-from-buffer | |
| 618 (current-buffer) nil nil)) | |
| 619 (temporary-file-name (make-temp-name | |
| 620 (expand-file-name "zjPQ2Pk" | |
| 621 (temp-directory))))) | |
| 622 (byte-compile-insert-header | |
| 623 temporary-file-name | |
| 624 (current-buffer) | |
| 625 byte-compile-result) | |
| 626 (Assert (not (string-match | |
| 627 ";;;###coding system:" | |
| 4133 | 628 (buffer-substring nil nil |
| 629 byte-compile-result)))))))) | |
| 3948 | 630 (insert |
| 4133 | 631 ;; Create a buffer with Unicode escapes. The #'read call is at |
| 632 ;; runtime, because this file may be compiled and read in a non-Mule | |
| 633 ;; XEmacs. (But it won't be run.) | |
| 634 (read | |
| 635 "#r\" (defvar testing-mule-compilation-handling | |
| 636 (string ?\\u371E ;; kDefinition beautiful; pretty, used | |
| 3948 | 637 ;; in girl's name |
| 4133 | 638 ?\\U0002A6A9 ;; kDefinition (Cant.) sound of shouting |
| 639 ?\\U0002A65B ;; kDefinition (Cant.) decayed teeth; | |
| 3948 | 640 ;; tongue-tied |
| 4133 | 641 ?\\U00010400 ;; DESERET CAPITAL LETTER LONG I |
| 642 ?\\u3263)) ;; CIRCLED HANGUL RIEUL \"")) | |
| 3948 | 643 |
| 644 (Assert-elc-is-escape-quoted) | |
| 645 (delete-region (point-min) (point-max)) | |
| 646 | |
| 647 (insert | |
| 648 ;; This time, the buffer will contain the actual characters, because of | |
| 649 ;; u flag to the #r. | |
| 4133 | 650 (read |
| 651 "#ru\" (defvar testing-mule-compilation-handling | |
| 652 (string ?\\u371E ;; kDefinition beautiful; pretty, used | |
| 3948 | 653 ;; in girl's name |
| 4133 | 654 ?\\U0002A6A9 ;; kDefinition (Cant.) sound of shouting |
| 655 ?\\U0002A65B ;; kDefinition (Cant.) decayed teeth; | |
| 3948 | 656 ;; tongue-tied |
| 4133 | 657 ?\\U00010400 ;; DESERET CAPITAL LETTER LONG I |
| 658 ?\\u3263)) ;; CIRCLED HANGUL RIEUL \"")) | |
| 3948 | 659 |
| 660 (Assert-elc-is-escape-quoted) | |
| 661 (delete-region (point-min) (point-max)) | |
| 662 | |
| 663 (insert | |
| 664 ;; Just a single four character escape. | |
| 4133 | 665 (read |
| 666 "#r\" (defvar testing-mule-compilation-handling | |
| 667 (string ?\\u371E)) ;; kDefinition beautiful; pretty, used\"")) | |
| 3948 | 668 |
| 669 (Assert-elc-is-escape-quoted) | |
| 670 (delete-region (point-min) (point-max)) | |
| 671 | |
| 672 (insert | |
| 673 ;; Just a single eight character escape. | |
| 4133 | 674 (read |
| 675 "#r\" (defvar testing-mule-compilation-handling | |
| 676 (string ?\\U0002A65B)) ;; kDefinition (Cant.) decayed teeth;\"")) | |
| 3948 | 677 |
| 678 (Assert-elc-is-escape-quoted) | |
| 679 (delete-region (point-min) (point-max)) | |
| 680 | |
| 681 (insert | |
| 4133 | 682 ;; A single latin-1 hex digit escape No run-time #'read call, |
| 683 ;; non-Mule can handle this too. | |
| 3948 | 684 #r" (defvar testing-mule-compilation-handling |
| 4133 | 685 (string ?\xab)) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK") |
| 686 | |
| 687 (Assert-elc-has-no-specified-encoding) | |
| 688 (delete-region (point-min) (point-max)) | |
| 689 | |
| 690 (insert | |
| 691 ;; A single latin-1 character. No run-time #'read call. | |
| 692 #ru" (defvar testing-mule-compilation-handling | |
| 693 (string ?\u00AB)) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK\")") | |
| 3948 | 694 |
| 695 (Assert-elc-has-no-specified-encoding) | |
| 696 (delete-region (point-min) (point-max)) | |
| 697 | |
| 698 (insert | |
| 4133 | 699 ;; Just ASCII. No run-time #'read call |
| 700 #r" (defvar testing-mule-compilation-handling | |
| 701 (string ?A)) ;; LATIN CAPITAL LETTER A") | |
| 3948 | 702 |
| 703 (Assert-elc-has-no-specified-encoding) | |
| 704 (delete-region (point-min) (point-max)) | |
| 705 | |
| 4133 | 706 ;; This bug exists because the coding-cookie insertion code looks at |
| 707 ;; the input buffer, not the output buffer. | |
| 708 ;; | |
| 709 ;; It looks at the input buffer because byte-compile-dynamic and | |
| 710 ;; byte-compile-dynamic-docstrings currently need to be | |
| 711 ;; unconditionally turned off for Mule files, since dynamic | |
| 712 ;; compilation of function bodies and docstrings fails if you can't | |
| 713 ;; call (point) and trivially get the byte offset in the file. | |
| 714 ;; | |
| 715 ;; And to unconditionally turn those two features off, you need to | |
| 716 ;; know before byte-compilation whether the byte-compilation output | |
| 717 ;; file contains non-Latin-1 characters, or perhaps to check after | |
| 718 ;; compilation and redo; but we don't do the latter. | |
| 719 ;; | |
| 720 ;; To fix this bug, we need to add Mule support to | |
| 721 ;; byte-compile-dynamic and byte-compile-dynamic-docstrings. Or drop | |
| 722 ;; support for those features entirely. | |
| 3948 | 723 (insert |
| 4133 | 724 "(defvar testing-mule-compilation-handling (eval-when-compile |
| 725 (decode-char 'ucs #x371e))) ;; kDefinition beautiful; pretty, used\"") | |
| 726 (Known-Bug-Expect-Failure | |
| 727 (Assert-elc-is-escape-quoted)) | |
| 3948 | 728 (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
|
729 |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
730 (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
|
731 invalid-constant |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
732 (loop |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
733 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
|
734 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
|
735 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
|
736 (#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
|
737 (#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
|
738 (#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
|
739 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
|
740 (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
|
741 finally return t)) |
| 434 | 742 ) |