Mercurial > hg > xemacs-beta
annotate tests/automated/mule-tests.el @ 5050:6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
-------------------- ChangeLog entries follow: --------------------
ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* configure.ac (XE_COMPLEX_ARG):
Correct doc of --quick-build: It also doesn't check for Lisp shadows.
src/ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* EmacsFrame.c:
* EmacsFrame.c (EmacsFrameRecomputeCellSize):
* alloca.c (i00afunc):
* buffer.c:
* buffer.c (MARKED_SLOT):
* buffer.c (complex_vars_of_buffer):
* cm.c:
* cm.c (cmcheckmagic):
* console.c:
* console.c (MARKED_SLOT):
* device-x.c:
* device-x.c (x_get_visual_depth):
* emacs.c (sort_args):
* eval.c (throw_or_bomb_out):
* event-stream.c:
* event-stream.c (Fadd_timeout):
* event-stream.c (Fadd_async_timeout):
* event-stream.c (Frecent_keys):
* events.c:
* events.c (Fdeallocate_event):
* events.c (event_pixel_translation):
* extents.c:
* extents.c (process_extents_for_insertion_mapper):
* fns.c (Fbase64_encode_region):
* fns.c (Fbase64_encode_string):
* fns.c (Fbase64_decode_region):
* fns.c (Fbase64_decode_string):
* font-lock.c:
* font-lock.c (find_context):
* frame-x.c:
* frame-x.c (x_wm_mark_shell_size_user_specified):
* frame-x.c (x_wm_mark_shell_position_user_specified):
* frame-x.c (x_wm_set_shell_iconic_p):
* frame-x.c (x_wm_set_cell_size):
* frame-x.c (x_wm_set_variable_size):
* frame-x.c (x_wm_store_class_hints):
* frame-x.c (x_wm_maybe_store_wm_command):
* frame-x.c (x_initialize_frame_size):
* frame.c (delete_frame_internal):
* frame.c (change_frame_size_1):
* free-hook.c (check_free):
* free-hook.c (note_block_input):
* free-hook.c (log_gcpro):
* gccache-gtk.c (gc_cache_lookup):
* gccache-x.c:
* gccache-x.c (gc_cache_lookup):
* glyphs-gtk.c:
* glyphs-gtk.c (init_image_instance_from_gdk_pixmap):
* glyphs-x.c:
* glyphs-x.c (extract_xpm_color_names):
* insdel.c:
* insdel.c (move_gap):
* keymap.c:
* keymap.c (keymap_lookup_directly):
* keymap.c (keymap_delete_inverse_internal):
* keymap.c (accessible_keymaps_mapper_1):
* keymap.c (where_is_recursive_mapper):
* lisp.h:
* lstream.c (make_lisp_buffer_stream_1):
* macros.c:
* macros.c (pop_kbd_macro_event):
* mc-alloc.c (remove_page_from_used_list):
* menubar-x.c:
* menubar-x.c (set_frame_menubar):
* ralloc.c:
* ralloc.c (obtain):
* ralloc.c (relinquish):
* ralloc.c (relocate_blocs):
* ralloc.c (resize_bloc):
* ralloc.c (r_alloc_free):
* ralloc.c (r_re_alloc):
* ralloc.c (r_alloc_thaw):
* ralloc.c (init_ralloc):
* ralloc.c (Free_Addr_Block):
* scrollbar-x.c:
* scrollbar-x.c (x_update_scrollbar_instance_status):
* sunplay.c (init_device):
* unexnt.c:
* unexnt.c (read_in_bss):
* unexnt.c (map_in_heap):
* window.c:
* window.c (real_window):
* window.c (window_display_lines):
* window.c (window_display_buffer):
* window.c (set_window_display_buffer):
* window.c (unshow_buffer):
* window.c (Fget_lru_window):
if (...) ABORT(); ---> assert();
More specifically:
if (x == y) ABORT (); --> assert (x != y);
if (x != y) ABORT (); --> assert (x == y);
if (x > y) ABORT (); --> assert (x <= y);
etc.
if (!x) ABORT (); --> assert (x);
if (x) ABORT (); --> assert (!x);
DeMorgan's Law's applied and manually simplified:
if (x && !y) ABORT (); --> assert (!x || y);
if (!x || y >= z) ABORT (); --> assert (x && y < z);
Checked to make sure that assert() of an expression with side
effects ensures that the side effects get executed even when
asserts are disabled, and add a comment about this being a
requirement of any "disabled assert" expression.
* depend:
* make-src-depend:
* make-src-depend (PrintDeps):
Fix broken code in make-src-depend so it does what it was always
supposed to do, which was separate out config.h and lisp.h and
all the files they include into separate variables in the
depend part of Makefile so that quick-build can turn off the
lisp.h/config.h/text.h/etc. dependencies of the source files, to
speed up recompilation.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sat, 20 Feb 2010 05:05:54 -0600 |
| parents | db2db229ee82 |
| children | ae4ddcdf30c0 |
| 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) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
68 (Assert-equal (buffer-string) string)) |
| 428 | 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) |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
155 (Assert-eq (find-coding-system coding-system) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
156 buffer-file-coding-system) |
|
4647
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4623
diff
changeset
|
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) |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
159 (Assert-eq (find-coding-system coding-system) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
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) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
180 (Assert-eq (aref string 0) ,char2) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
181 (Assert-eq (aref string (1- (length string))) ,char2) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
182 (Assert-eq (length string) 1000))))) |
| 434 | 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)) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
191 (Assert-eq (aref string 1) (make-char 'latin-iso8859-2 69))) |
| 434 | 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))) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
213 (Assert-eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
214 (Assert-eq 'binary (coding-system-aliasee 'mule-tests-alias)) |
| 440 | 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))) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
222 (Assert-eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
223 (Assert-eq 'binary (coding-system-aliasee 'mule-tests-alias)) |
| 440 | 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))) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
231 (Assert-eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias)) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
232 (Assert-eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
233 (Assert-eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)) |
| 440 | 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))) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
269 (Assert-eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
270 (Assert-eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)) |
| 440 | 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))) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
278 (Assert-eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
279 (Assert-eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)) |
| 440 | 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)) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
283 (Assert-eq (find-coding-system 'mule-tests-alias-mac) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
284 (find-coding-system 'iso-8859-7-mac)) |
| 440 | 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))) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
289 (Assert-eq (get-coding-system 'iso-8859-7) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
290 (get-coding-system 'nested-mule-tests-alias)) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
291 (Assert-eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
292 (Assert-eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)) |
| 440 | 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)) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
296 (Assert-eq (find-coding-system 'nested-mule-tests-alias-unix) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
297 (find-coding-system 'iso-8859-7-unix)) |
| 440 | 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 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
354 (Assert-equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))) |
| 438 | 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 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
361 (Assert-equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))) |
| 438 | 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 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
368 (Assert-equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string))) |
| 438 | 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 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
375 (Assert-equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))) |
| 438 | 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 | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4731
diff
changeset
|
388 (if (or (string-match "darwin" system-configuration) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4731
diff
changeset
|
389 (featurep 'cygwin-use-utf-8)) |
| 2026 | 390 'utf-8 |
| 391 'iso-8859-2)) | |
| 3970 | 392 ;; make-temp-name does stat(), which on OS X requires that you |
| 393 ;; normalise, where open() will normalise for you. Previously we | |
| 394 ;; used scaron as the Latin-2 character, and make-temp-name errored | |
| 3976 | 395 ;; on OS X. LATIN CAPITAL LETTER D WITH STROKE does not decompose. |
| 3970 | 396 (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
|
397 (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
|
398 (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
|
399 working-symlinks) |
| 3472 | 400 (Assert (not (equal name1 name2))) |
| 401 (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
|
402 ;; This is how you suppress output from `message', called by `write-region' |
| 3472 | 403 (Silence-Message |
| 404 (write-region (point-min) (point-max) name1)) | |
| 405 (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
|
406 (Silence-Message |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4399
diff
changeset
|
407 (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
|
408 (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
|
409 (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
|
410 (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
|
411 (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
|
412 ;; 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
|
413 ;; 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
|
414 (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
|
415 (when working-symlinks |
| 3472 | 416 (make-symbolic-link name1 name2) |
| 417 (Assert (file-exists-p name2)) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
418 (Assert-equal (file-truename name2) name1) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
419 (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
|
420 (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
|
421 (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
|
422 (ignore-file-errors (delete-file name3))) |
| 442 | 423 |
| 424 ;; Add many more file operation tests here... | |
| 425 | |
| 426 ;;--------------------------------------------------------------- | |
| 427 ;; Test Unicode-related functions | |
| 428 ;;--------------------------------------------------------------- | |
| 4861 | 429 (let* ((scaron (make-char 'latin-iso8859-2 57))) |
| 875 | 430 ;; 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
|
431 (loop |
|
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
432 for code in '(#x0100 #x2222 #x4444 #xffff) |
| 4861 | 433 with initial-unicode = (char-to-unicode scaron) |
|
4715
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
434 do |
| 442 | 435 (progn |
| 4861 | 436 (set-unicode-conversion scaron code) |
| 437 (Assert-eq code (char-to-unicode scaron)) | |
| 438 (Assert-eq scaron (unicode-to-char code '(latin-iso8859-2)))) | |
| 439 finally (set-unicode-conversion scaron initial-unicode)) | |
| 440 (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000))) | |
| 1195 | 441 |
| 3439 | 442 (dolist (utf-8-char |
| 443 '("\xc6\x92" ;; U+0192 LATIN SMALL LETTER F WITH HOOK | |
| 444 "\xe2\x81\x8a" ;; U+204A TIRONIAN SIGN ET | |
| 445 "\xe2\x82\xae" ;; U+20AE TUGRIK SIGN | |
| 446 "\xf0\x9d\x92\xbd" ;; U+1D4BD MATHEMATICAL SCRIPT SMALL H | |
| 447 "\xf0\x9d\x96\x93" ;; U+1D593 MATHEMATICAL BOLD FRAKTUR SMALL N | |
| 448 "\xf0\xaf\xa8\x88" ;; U+2FA08 CJK COMPATIBILITY FOR U+4BCE | |
| 449 "\xf4\x8f\xbf\xbd")) ;; U+10FFFD <Plane 16 Private Use, Last> | |
| 450 (let* ((xemacs-character (car (append | |
| 451 (decode-coding-string utf-8-char 'utf-8) | |
| 452 nil))) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
453 (xemacs-charset (char-charset xemacs-character))) |
| 3439 | 454 |
| 455 ;; Trivial test of the UTF-8 support of the escape-quoted character set. | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
456 (Assert-equal (decode-coding-string utf-8-char 'utf-8) |
| 3439 | 457 (decode-coding-string (concat "\033%G" utf-8-char) |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
458 'escape-quoted)) |
| 3439 | 459 |
| 460 ;; Check that the reverse mapping holds. | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
461 (Assert-equal (unicode-code-point-to-utf-8-string |
| 3439 | 462 (encode-char xemacs-character 'ucs)) |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
463 utf-8-char) |
| 3439 | 464 |
| 465 ;; Check that, if this character has been JIT-allocated, it is encoded | |
| 466 ;; in escape-quoted using the corresponding UTF-8 escape. | |
| 467 (when (charset-property xemacs-charset 'encode-as-utf-8) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
468 (Assert-equal (concat "\033%G" utf-8-char) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
469 (encode-coding-string xemacs-character 'escape-quoted)) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
470 (Assert-equal (concat "\033%G" utf-8-char) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
471 (encode-coding-string xemacs-character 'ctext))))) |
| 3439 | 472 |
| 3952 | 473 (loop |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
474 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
|
475 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
|
476 (#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
|
477 do |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
478 (Assert-equal (encode-coding-string |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
479 (decode-char 'ucs code-point) 'utf-16) |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
480 utf-16-big-endian) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
481 (Assert-equal (encode-coding-string |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
482 (decode-char 'ucs code-point) 'utf-16-le) |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
483 utf-16-little-endian)) |
|
4583
2669b1b7e33b
Correct little-endian UTF-16 surrogate handling.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4495
diff
changeset
|
484 |
| 3952 | 485 |
| 1195 | 486 ;;--------------------------------------------------------------- |
| 3690 | 487 ;; Regression test for a couple of CCL-related bugs. |
| 488 ;;--------------------------------------------------------------- | |
| 489 | |
| 490 (let ((ccl-vector [0 0 0 0 0 0 0 0 0])) | |
| 491 (define-ccl-program ccl-write-two-control-1-chars | |
| 492 `(1 | |
| 493 ((r0 = ,(charset-id 'control-1)) | |
| 494 (r1 = 0) | |
| 495 (write-multibyte-character r0 r1) | |
| 496 (r1 = 31) | |
| 497 (write-multibyte-character r0 r1))) | |
| 498 "CCL program that writes two control-1 multibyte characters.") | |
| 499 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
500 (Assert-equal |
| 3690 | 501 (ccl-execute-on-string 'ccl-write-two-control-1-chars |
| 502 ccl-vector "") | |
| 503 (format "%c%c" (make-char 'control-1 0) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
504 (make-char 'control-1 31))) |
| 3690 | 505 |
| 506 (define-ccl-program ccl-unicode-two-control-1-chars | |
| 507 `(1 | |
| 508 ((r0 = ,(charset-id 'control-1)) | |
| 509 (r1 = 31) | |
| 510 (mule-to-unicode r0 r1) | |
| 511 (r4 = r0) | |
| 512 (r3 = ,(charset-id 'control-1)) | |
| 513 (r2 = 0) | |
| 514 (mule-to-unicode r3 r2))) | |
| 515 "CCL program that writes two control-1 UCS code points in r3 and r4") | |
| 516 | |
| 517 ;; Re-initialise the vector, mainly to clear the instruction counter, | |
| 518 ;; which is its last element. | |
| 519 (setq ccl-vector [0 0 0 0 0 0 0 0 0]) | |
| 520 | |
| 521 (ccl-execute-on-string 'ccl-unicode-two-control-1-chars ccl-vector "") | |
| 522 | |
| 523 (Assert (and (eq (aref ccl-vector 3) | |
| 524 (encode-char (make-char 'control-1 0) 'ucs)) | |
| 525 (eq (aref ccl-vector 4) | |
| 526 (encode-char (make-char 'control-1 31) 'ucs))))) | |
| 527 | |
| 4295 | 528 |
| 529 ;; Test the 8 bit fixed-width coding systems for round-trip | |
| 530 ;; compatibility with themselves. | |
| 531 (loop | |
| 532 for coding-system in (coding-system-list) | |
| 533 with all-possible-octets = (apply #'string | |
| 534 (loop for i from ?\x00 to ?\xFF | |
| 535 collect i)) | |
| 536 do | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4688
diff
changeset
|
537 (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
|
538 ;; 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
|
539 ;; (maybe we should): |
|
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
540 (eq 'lf (coding-system-eol-type coding-system))) |
| 4295 | 541 ;; These coding systems are round-trip compatible with themselves. |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
542 (Assert-equal (encode-coding-string |
| 4295 | 543 (decode-coding-string all-possible-octets |
| 544 coding-system) | |
| 545 coding-system) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
546 all-possible-octets |
|
4715
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4690
diff
changeset
|
547 (format "checking %s is transparent" coding-system)))) |
| 4295 | 548 |
| 3690 | 549 ;;--------------------------------------------------------------- |
| 1195 | 550 ;; Test charset-in-* functions |
| 551 ;;--------------------------------------------------------------- | |
| 552 (with-temp-buffer | |
| 553 (insert-file-contents (locate-data-file "HELLO")) | |
|
4884
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
554 (let ((sorted-charsets-in-HELLO |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
555 '(arabic-iso8859-6 ascii chinese-big5-1 chinese-gb2312 |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
556 cyrillic-iso8859-5 ethiopic greek-iso8859-7 |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
557 hebrew-iso8859-8 japanese-jisx0208 japanese-jisx0212 |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
558 katakana-jisx0201 korean-ksc5601 latin-iso8859-1 |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
559 latin-iso8859-2 vietnamese-viscii-lower))) |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
560 (Assert-equal |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
561 ;; The sort is to make the algorithm of charsets-in-region |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
562 ;; irrelevant. |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
563 (sort (charsets-in-region (point-min) (point-max)) |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
564 #'string<) |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
565 sorted-charsets-in-HELLO) |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
566 (Assert-equal |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
567 (sort (charsets-in-string (buffer-substring (point-min) |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
568 (point-max))) |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
569 #'string<) |
|
29fb3baea939
Fix the bugs necessary to resolve the trivial test failures in mule-tests.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4861
diff
changeset
|
570 sorted-charsets-in-HELLO))) |
| 3948 | 571 |
| 4133 | 572 ;;--------------------------------------------------------------- |
| 573 ;; Language environments, and whether the specified values are sane. | |
| 574 ;;--------------------------------------------------------------- | |
| 575 (loop | |
| 576 for language in (mapcar #'car language-info-alist) | |
| 577 with language-input-method = nil | |
| 4305 | 578 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
|
579 with original-language-environment = current-language-environment |
| 4133 | 580 do |
| 581 ;; s-l-e can call #'require, which says "Loading ..." | |
| 582 (Silence-Message (set-language-environment language)) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
583 (Assert-equal language current-language-environment) |
| 4133 | 584 |
| 585 (setq language-input-method | |
| 586 (get-language-info language 'input-method)) | |
| 587 (when (and language-input-method | |
| 588 ;; #### Not robust, if more input methods besides canna are | |
| 589 ;; in core. The intention of this is that if *any* of the | |
| 590 ;; packages' input methods are available, we check that *all* | |
| 591 ;; of the language environments' input methods actually | |
| 592 ;; exist, which goes against the spirit of non-monolithic | |
| 593 ;; packages. But I don't have a better approach to this. | |
| 594 (> (length input-method-alist) 1)) | |
| 595 (Assert (assoc language-input-method input-method-alist)) | |
| 596 (Skip-Test-Unless | |
| 597 (assoc language-input-method input-method-alist) | |
| 598 "input method unavailable" | |
| 599 (format "check that IM %s can be activated" language-input-method) | |
| 600 ;; s-i-m can load files. | |
| 601 (Silence-Message | |
| 602 (set-input-method language-input-method)) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
603 (Assert-equal language-input-method current-input-method))) |
| 4133 | 604 |
| 3970 | 605 (dolist (charset (get-language-info language 'charset)) |
| 606 (Assert (charsetp (find-charset charset)))) | |
| 607 (dolist (coding-system (get-language-info language 'coding-system)) | |
| 608 (Assert (coding-system-p (find-coding-system coding-system)))) | |
| 4305 | 609 (dolist (coding-system |
| 610 (if (listp (setq native-coding-system | |
| 611 (get-language-info language | |
| 612 'native-coding-system))) | |
| 613 native-coding-system | |
| 614 (list native-coding-system))) | |
| 4133 | 615 ;; We don't have the appropriate POSIX locales to test with a |
| 616 ;; native-coding-system that is a function. | |
| 617 (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
|
618 (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
|
619 finally (set-language-environment original-language-environment)) |
| 3970 | 620 |
| 3948 | 621 (with-temp-buffer |
| 622 (flet | |
| 623 ((Assert-elc-is-escape-quoted () | |
| 624 "Assert the current buffer has an escape-quoted cookie if compiled." | |
| 625 (save-excursion | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
626 (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
|
627 (expand-file-name "zjPQ2Pk" |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
628 (temp-directory)))) |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
629 (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
|
630 (current-buffer) temporary-file-name |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
631 nil))) |
| 4133 | 632 (Assert (string-match |
| 633 "^;;;###coding system: escape-quoted" | |
| 634 (buffer-substring nil nil byte-compile-result)))))) | |
| 3948 | 635 (Assert-elc-has-no-specified-encoding () |
| 636 "Assert the current buffer has no coding cookie if compiled." | |
| 637 (save-excursion | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
638 (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
|
639 (expand-file-name "zjPQ2Pk" |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
640 (temp-directory)))) |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
641 (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
|
642 (current-buffer) temporary-file-name |
|
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
643 nil))) |
| 3948 | 644 (Assert (not (string-match |
| 645 ";;;###coding system:" | |
| 4133 | 646 (buffer-substring nil nil |
| 647 byte-compile-result)))))))) | |
| 3948 | 648 (insert |
| 4133 | 649 ;; Create a buffer with Unicode escapes. The #'read call is at |
| 650 ;; runtime, because this file may be compiled and read in a non-Mule | |
| 651 ;; XEmacs. (But it won't be run.) | |
| 652 (read | |
| 653 "#r\" (defvar testing-mule-compilation-handling | |
| 654 (string ?\\u371E ;; kDefinition beautiful; pretty, used | |
| 3948 | 655 ;; in girl's name |
| 4133 | 656 ?\\U0002A6A9 ;; kDefinition (Cant.) sound of shouting |
| 657 ?\\U0002A65B ;; kDefinition (Cant.) decayed teeth; | |
| 3948 | 658 ;; tongue-tied |
| 4133 | 659 ?\\U00010400 ;; DESERET CAPITAL LETTER LONG I |
| 660 ?\\u3263)) ;; CIRCLED HANGUL RIEUL \"")) | |
| 3948 | 661 |
| 662 (Assert-elc-is-escape-quoted) | |
| 663 (delete-region (point-min) (point-max)) | |
| 664 | |
| 665 (insert | |
| 666 ;; This time, the buffer will contain the actual characters, because of | |
| 667 ;; u flag to the #r. | |
| 4133 | 668 (read |
| 669 "#ru\" (defvar testing-mule-compilation-handling | |
| 670 (string ?\\u371E ;; kDefinition beautiful; pretty, used | |
| 3948 | 671 ;; in girl's name |
| 4133 | 672 ?\\U0002A6A9 ;; kDefinition (Cant.) sound of shouting |
| 673 ?\\U0002A65B ;; kDefinition (Cant.) decayed teeth; | |
| 3948 | 674 ;; tongue-tied |
| 4133 | 675 ?\\U00010400 ;; DESERET CAPITAL LETTER LONG I |
| 676 ?\\u3263)) ;; CIRCLED HANGUL RIEUL \"")) | |
| 3948 | 677 |
| 678 (Assert-elc-is-escape-quoted) | |
| 679 (delete-region (point-min) (point-max)) | |
| 680 | |
| 681 (insert | |
| 682 ;; Just a single four character escape. | |
| 4133 | 683 (read |
| 684 "#r\" (defvar testing-mule-compilation-handling | |
| 685 (string ?\\u371E)) ;; kDefinition beautiful; pretty, used\"")) | |
| 3948 | 686 |
| 687 (Assert-elc-is-escape-quoted) | |
| 688 (delete-region (point-min) (point-max)) | |
| 689 | |
| 690 (insert | |
| 691 ;; Just a single eight character escape. | |
| 4133 | 692 (read |
| 693 "#r\" (defvar testing-mule-compilation-handling | |
| 694 (string ?\\U0002A65B)) ;; kDefinition (Cant.) decayed teeth;\"")) | |
| 3948 | 695 |
| 696 (Assert-elc-is-escape-quoted) | |
| 697 (delete-region (point-min) (point-max)) | |
| 698 | |
| 699 (insert | |
| 4133 | 700 ;; A single latin-1 hex digit escape No run-time #'read call, |
| 701 ;; non-Mule can handle this too. | |
| 3948 | 702 #r" (defvar testing-mule-compilation-handling |
| 4133 | 703 (string ?\xab)) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK") |
| 704 | |
| 705 (Assert-elc-has-no-specified-encoding) | |
| 706 (delete-region (point-min) (point-max)) | |
| 707 | |
| 708 (insert | |
| 709 ;; A single latin-1 character. No run-time #'read call. | |
| 710 #ru" (defvar testing-mule-compilation-handling | |
| 711 (string ?\u00AB)) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK\")") | |
| 3948 | 712 |
| 713 (Assert-elc-has-no-specified-encoding) | |
| 714 (delete-region (point-min) (point-max)) | |
| 715 | |
| 716 (insert | |
| 4133 | 717 ;; Just ASCII. No run-time #'read call |
| 718 #r" (defvar testing-mule-compilation-handling | |
| 719 (string ?A)) ;; LATIN CAPITAL LETTER A") | |
| 3948 | 720 |
| 721 (Assert-elc-has-no-specified-encoding) | |
| 722 (delete-region (point-min) (point-max)) | |
| 723 | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
724 ;; 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
|
725 ;; looks at the input buffer, not the output buffer. |
| 4133 | 726 ;; |
| 727 ;; It looks at the input buffer because byte-compile-dynamic and | |
| 728 ;; byte-compile-dynamic-docstrings currently need to be | |
| 729 ;; unconditionally turned off for Mule files, since dynamic | |
| 730 ;; compilation of function bodies and docstrings fails if you can't | |
| 731 ;; call (point) and trivially get the byte offset in the file. | |
| 732 ;; | |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
733 ;; 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
|
734 ;; 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
|
735 ;; 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
|
736 ;; 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
|
737 ;; 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
|
738 ;; issue. |
| 4133 | 739 ;; |
|
4623
a9f83990e6bf
Fix a byte compiler bug with characters above ?\xFF.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4620
diff
changeset
|
740 ;; 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
|
741 ;; 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
|
742 ;; effort today (February 2009). |
| 3948 | 743 (insert |
| 4133 | 744 "(defvar testing-mule-compilation-handling (eval-when-compile |
| 745 (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
|
746 (Assert-elc-is-escape-quoted) |
| 3948 | 747 (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
|
748 |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
749 (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
|
750 invalid-constant |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
751 (loop |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4305
diff
changeset
|
752 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
|
753 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
|
754 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
|
755 (#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
|
756 (#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
|
757 (#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
|
758 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
|
759 (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
|
760 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
|
761 (loop |
|
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
762 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
|
763 do (Assert |
|
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
764 (= 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
|
765 (format |
|
7e54adf407a1
Fix a bug with Unicode error sequences and very short input strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4672
diff
changeset
|
766 "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
|
767 i))) |
|
4731
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
768 |
|
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 ;; Process tests |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
771 ;; #### 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
|
772 ;;--------------------------------------------------------------- |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
773 (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
|
774 (fboundp 'executable-find) |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
775 (executable-find "cat")) |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
776 "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
|
777 "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
|
778 (with-temp-buffer |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
779 (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
|
780 (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
|
781 t)))) |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
782 |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
783 ) ; 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
|
784 |
|
ad40dc9d3a97
Add test of nil binding of default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4715
diff
changeset
|
785 ;;; end of mule-tests.el |