annotate tests/automated/mule-tests.el @ 934:c925bacdda60

[xemacs-hg @ 2002-07-29 09:21:12 by michaels] 2002-07-17 Marcus Crestani <crestani@informatik.uni-tuebingen.de> Markus Kaltenbach <makalten@informatik.uni-tuebingen.de> Mike Sperber <mike@xemacs.org> configure flag to turn these changes on: --use-kkcc First we added a dumpable flag to lrecord_implementation. It shows, if the object is dumpable and should be processed by the dumper. * lrecord.h (struct lrecord_implementation): added dumpable flag (MAKE_LRECORD_IMPLEMENTATION): fitted the different makro definitions to the new lrecord_implementation and their calls. Then we changed mark_object, that it no longer needs a mark method for those types that have pdump descritions. * alloc.c: (mark_object): If the object has a description, the new mark algorithm is called, and the object is marked according to its description. Otherwise it uses the mark method like before. These procedures mark objects according to their descriptions. They are modeled on the corresponding pdumper procedures. (mark_with_description): (get_indirect_count): (structure_size): (mark_struct_contents): These procedures still call mark_object, this is needed while there are Lisp_Objects without descriptions left. We added pdump descriptions for many Lisp_Objects: * extents.c: extent_auxiliary_description * database.c: database_description * gui.c: gui_item_description * scrollbar.c: scrollbar_instance_description * toolbar.c: toolbar_button_description * event-stream.c: command_builder_description * mule-charset.c: charset_description * device-msw.c: devmode_description * dialog-msw.c: mswindows_dialog_id_description * eldap.c: ldap_description * postgresql.c: pgconn_description pgresult_description * tooltalk.c: tooltalk_message_description tooltalk_pattern_description * ui-gtk.c: emacs_ffi_description emacs_gtk_object_description * events.c: * events.h: * event-stream.c: * event-Xt.c: * event-gtk.c: * event-tty.c: To write a pdump description for Lisp_Event, we converted every struct in the union event to a Lisp_Object. So we created nine new Lisp_Objects: Lisp_Key_Data, Lisp_Button_Data, Lisp_Motion_Data, Lisp_Process_Data, Lisp_Timeout_Data, Lisp_Eval_Data, Lisp_Misc_User_Data, Lisp_Magic_Data, Lisp_Magic_Eval_Data. We also wrote makro selectors and mutators for the fields of the new designed Lisp_Event and added everywhere these new abstractions. We implemented XD_UNION support in (mark_with_description), so we can describe exspecially console/device specific data with XD_UNION. To describe with XD_UNION, we added a field to these objects, which holds the variant type of the object. This field is initialized in the appendant constructor. The variant is an integer, it has also to be described in an description, if XD_UNION is used. XD_UNION is used in following descriptions: * console.c: console_description (get_console_variant): returns the variant (create_console): added variant initialization * console.h (console_variant): the different console types * console-impl.h (struct console): added enum console_variant contype * device.c: device_description (Fmake_device): added variant initialization * device-impl.h (struct device): added enum console_variant devtype * objects.c: image_instance_description font_instance_description (Fmake_color_instance): added variant initialization (Fmake_font_instance): added variant initialization * objects-impl.h (struct Lisp_Color_Instance): added color_instance_type * objects-impl.h (struct Lisp_Font_Instance): added font_instance_type * process.c: process_description (make_process_internal): added variant initialization * process.h (process_variant): the different process types
author michaels
date Mon, 29 Jul 2002 09:21:25 +0000
parents 708faa3b4cb1
children dff007bd492b
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.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org>
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4 ;; Maintainers: Hrvoje Niksic <hniksic@xemacs.org>,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
5 ;; Martin Buchholz <martin@xemacs.org>
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Created: 1999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Keywords: tests
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; 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
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; Test some Mule functionality (most of these remain to be written) .
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; See test-harness.el for instructions on how to run these tests.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
33 ;; 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
34 ;; literal non-Latin1 characters. Use (make-char) instead.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
35
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;;-----------------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; Test whether all legal chars may be safely inserted to a buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;;-----------------------------------------------------------------
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 (defun test-chars (&optional for-test-harness)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 "Insert all characters in a buffer, to see if XEmacs will crash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 This is done by creating a string with all the legal characters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 in [0, 2^19) range, inserting it into the buffer, and checking
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 that the buffer's contents are equivalent to the string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 If FOR-TEST-HARNESS is specified, a temporary buffer is used, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 the Assert macro checks for correctness."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 (let ((max (expt 2 (if (featurep 'mule) 19 8)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (list nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 (i 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 (while (< i max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 (and (not for-test-harness)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 (zerop (% i 1000))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 (message "%d" i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 (and (int-char i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;; Don't aset to a string directly because random string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; access is O(n) under Mule.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (setq list (cons (int-char i) list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (setq i (1+ i)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 (let ((string (apply #'string (nreverse list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (if for-test-harness
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;; For use with test-harness, use Assert and a temporary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (with-temp-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (insert string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (Assert (equal (buffer-string) string)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; For use without test harness: use a normal buffer, so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;; you can also test whether redisplay works.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (switch-to-buffer (get-buffer-create "test"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (buffer-disable-undo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (insert string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (assert (equal (buffer-string) string))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; 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
76 ;; 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
77 ;; time-consuming tests like this one run twice, once interpreted and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;; once compiled, for no good reason.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (test-chars t)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
80
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
81 ;;-----------------------------------------------------------------
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
82 ;; Test string modification functions that modify the length of a char.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
83 ;;-----------------------------------------------------------------
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
84
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
85 (when (featurep 'mule)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
86 ;;---------------------------------------------------------------
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
87 ;; Test fillarray
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
88 ;;---------------------------------------------------------------
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
89 (macrolet
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
90 ((fillarray-test
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
91 (charset1 charset2)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
92 (let ((char1 (make-char charset1 69))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
93 (char2 (make-char charset2 69)))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
94 `(let ((string (make-string 1000 ,char1)))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
95 (fillarray string ,char2)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
96 (Assert (eq (aref string 0) ,char2))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
97 (Assert (eq (aref string (1- (length string))) ,char2))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
98 (Assert (eq (length string) 1000))))))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
99 (fillarray-test ascii latin-iso8859-1)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
100 (fillarray-test ascii latin-iso8859-2)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
101 (fillarray-test latin-iso8859-1 ascii)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
102 (fillarray-test latin-iso8859-2 ascii))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
103
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
104 ;; Test aset
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
105 (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
106 (aset string 0 (make-char 'latin-iso8859-2 42))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
107 (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69))))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
108
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
109 ;;---------------------------------------------------------------
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
110 ;; Test coding system functions
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
111 ;;---------------------------------------------------------------
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
112
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
113 ;; Create alias for coding system without subsidiaries
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
114 (Assert (coding-system-p (find-coding-system 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
115 (Assert (coding-system-canonical-name-p 'binary))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
116 (Assert (not (coding-system-alias-p 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
117 (Assert (not (coding-system-alias-p 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
118 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
119 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
120 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
121 (define-coding-system-alias 'binary 'iso8859-2))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
122 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
123 error "Symbol is not a coding system alias"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
124 (coding-system-aliasee 'binary))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
125
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
126 (define-coding-system-alias 'mule-tests-alias 'binary)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
127 (Assert (coding-system-alias-p 'mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
128 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
129 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
130 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
131 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
132 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
133 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
134
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
135 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
136 (Assert (coding-system-alias-p 'mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
137 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
138 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
139 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
140 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
141 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
142 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
143
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
144 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
145 (Assert (coding-system-alias-p 'nested-mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
146 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
147 (Assert (eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
148 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
149 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
150 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
151 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
152 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
153
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
154 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
155 error "Attempt to create a coding system alias loop"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
156 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
157 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
158 error "No such coding system"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
159 (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
160 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
161 error "Attempt to create a coding system alias loop"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
162 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
163
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
164 (define-coding-system-alias 'nested-mule-tests-alias nil)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
165 (define-coding-system-alias 'mule-tests-alias nil)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
166 (Assert (coding-system-p (find-coding-system 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
167 (Assert (coding-system-canonical-name-p 'binary))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
168 (Assert (not (coding-system-alias-p 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
169 (Assert (not (coding-system-alias-p 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
170 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
171 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
172 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
173 (define-coding-system-alias 'binary 'iso8859-2))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
174 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
175 error "Symbol is not a coding system alias"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
176 (coding-system-aliasee 'binary))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
177
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
178 (define-coding-system-alias 'nested-mule-tests-alias nil)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
179 (define-coding-system-alias 'mule-tests-alias nil)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
180
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
181 ;; Create alias for coding system with subsidiaries
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
182 (define-coding-system-alias 'mule-tests-alias 'iso-8859-7)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
183 (Assert (coding-system-alias-p 'mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
184 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
185 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
186 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
187 (Assert (coding-system-alias-p 'mule-tests-alias-unix))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
188 (Assert (coding-system-alias-p 'mule-tests-alias-dos))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
189 (Assert (coding-system-alias-p 'mule-tests-alias-mac))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
190
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
191 (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
192 (Assert (coding-system-alias-p 'mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
193 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
194 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
195 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
196 (Assert (coding-system-alias-p 'mule-tests-alias-unix))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
197 (Assert (coding-system-alias-p 'mule-tests-alias-dos))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
198 (Assert (coding-system-alias-p 'mule-tests-alias-mac))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
199 (Assert (eq (find-coding-system 'mule-tests-alias-mac)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
200 (find-coding-system 'iso-8859-7-mac)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
201
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
202 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
203 (Assert (coding-system-alias-p 'nested-mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
204 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
205 (Assert (eq (get-coding-system 'iso-8859-7)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
206 (get-coding-system 'nested-mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
207 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
208 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
209 (Assert (coding-system-alias-p 'nested-mule-tests-alias-unix))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
210 (Assert (coding-system-alias-p 'nested-mule-tests-alias-dos))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
211 (Assert (coding-system-alias-p 'nested-mule-tests-alias-mac))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
212 (Assert (eq (find-coding-system 'nested-mule-tests-alias-unix)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
213 (find-coding-system 'iso-8859-7-unix)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
214
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
215 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
216 error "Attempt to create a coding system alias loop"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
217 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
218 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
219 error "No such coding system"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
220 (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
221 (Check-Error-Message
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
222 error "Attempt to create a coding system alias loop"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
223 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
224
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
225 ;; Test dangling alias deletion
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
226 (define-coding-system-alias 'mule-tests-alias nil)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
227 (Assert (not (coding-system-alias-p 'mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
228 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
229 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
230 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
231
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
232 ;;---------------------------------------------------------------
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
233 ;; 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
234 ;;---------------------------------------------------------------
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
235 (defun charset-char-string (charset)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
236 (let (lo hi string n)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
237 (if (= (charset-chars charset) 94)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
238 (setq lo 33 hi 126)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
239 (setq lo 32 hi 127))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
240 (if (= (charset-dimension charset) 1)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
241 (progn
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
242 (setq string (make-string (1+ (- hi lo)) ??))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
243 (setq n 0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
244 (loop for j from lo to hi do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
245 (progn
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
246 (aset string n (make-char charset j))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
247 (incf n)))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
248 string)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
249 (progn
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
250 (setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
251 (setq n 0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
252 (loop for j from lo to hi do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
253 (loop for k from lo to hi do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
254 (progn
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
255 (aset string n (make-char charset j k))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
256 (incf n))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
257 string))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
258
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
259 ;; The following two used to crash xemacs!
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
260 (Assert (charset-char-string 'japanese-jisx0208))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
261 (aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 77))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
262
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
263 (let ((greek-string (charset-char-string 'greek-iso8859-7))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
264 (string (make-string (* 96 60) ??)))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
265 (loop for j from 0 below (length string) do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
266 (aset string j (aref greek-string (mod j 96))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
267 (loop for k in '(0 1 58 59) do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
268 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
269
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
270 (let ((greek-string (charset-char-string 'greek-iso8859-7))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
271 (string (make-string (* 96 60) ??)))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
272 (loop for j from (1- (length string)) downto 0 do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
273 (aset string j (aref greek-string (mod j 96))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
274 (loop for k in '(0 1 58 59) do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
275 (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
276
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
277 (let ((ascii-string (charset-char-string 'ascii))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
278 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
279 (loop for j from 0 below (length string) do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
280 (aset string j (aref ascii-string (mod j 94))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
281 (loop for k in '(0 1 58 59) do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
282 (Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
283
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
284 (let ((ascii-string (charset-char-string 'ascii))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
285 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
286 (loop for j from (1- (length string)) downto 0 do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
287 (aset string j (aref ascii-string (mod j 94))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
288 (loop for k in '(0 1 58 59) do
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
289 (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
290
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
291 ;;---------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
292 ;; Test file-system character conversion (and, en passant, file ops)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
293 ;;---------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
294 (let* ((scaron (make-char 'latin-iso8859-2 57))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
295 (latin2-string (make-string 4 scaron))
597
ce085c4b3999 [xemacs-hg @ 2001-06-01 05:05:54 by martinb]
martinb
parents: 442
diff changeset
296 (prefix (concat (file-name-as-directory
ce085c4b3999 [xemacs-hg @ 2001-06-01 05:05:54 by martinb]
martinb
parents: 442
diff changeset
297 (file-truename (temp-directory)))
ce085c4b3999 [xemacs-hg @ 2001-06-01 05:05:54 by martinb]
martinb
parents: 442
diff changeset
298 latin2-string))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
299 (name1 (make-temp-name prefix))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
300 (name2 (make-temp-name prefix))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
301 (file-name-coding-system 'iso-8859-2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
302 ;; This is how you suppress output from `message', called by `write-region'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
303 (flet ((append-message (&rest args) ()))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
304 (Assert (not (equal name1 name2)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
305 (Assert (not (file-exists-p name1)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
306 (write-region (point-min) (point-max) name1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
307 (Assert (file-exists-p name1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
308 (when (fboundp 'make-symbolic-link)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
309 (make-symbolic-link name1 name2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
310 (Assert (file-exists-p name2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
311 (Assert (equal (file-truename name2) name1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
312 (Assert (equal (file-truename name1) name1)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
313
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
314 (ignore-file-errors (delete-file name1) (delete-file name2))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
315
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
316 ;; Add many more file operation tests here...
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
317
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
318 ;;---------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
319 ;; Test Unicode-related functions
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
320 ;;---------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
321 (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
322 ;; Used to try #x0000, but you can't change ASCII or Latin-1
708faa3b4cb1 [xemacs-hg @ 2002-06-23 06:53:46 by stephent]
stephent
parents: 800
diff changeset
323 (loop for code in '(#x0100 #x2222 #x4444 #xffff) do
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
324 (progn
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 597
diff changeset
325 (set-unicode-conversion scaron code)
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 597
diff changeset
326 (Assert (eq code (char-to-unicode scaron)))
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 597
diff changeset
327 (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
328
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 597
diff changeset
329 (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000)))
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
330 )