annotate tests/automated/mule-tests.el @ 5146:88bd4f3ef8e4

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