Mercurial > hg > xemacs-beta

comparison tests/automated/mule-tests.el @ 440:8de8e3f6228a r21-2-28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 84b14dcb0985
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
1 ;; Copyright (C) 1999 Free Software Foundation, Inc. 1 ;; Copyright (C) 1999 Free Software Foundation, Inc.
2 2
3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org> 3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org>
4 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> 4 ;; Maintainers: Hrvoje Niksic <hniksic@xemacs.org>,
5 ;; Martin Buchholz <martin@xemacs.org>
5 ;; Created: 1999 6 ;; Created: 1999
6 ;; Keywords: tests 7 ;; Keywords: tests
7 8
8 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
9 10
101 ;; Test aset 102 ;; Test aset
102 (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69)))) 103 (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69))))
103 (aset string 0 (make-char 'latin-iso8859-2 42)) 104 (aset string 0 (make-char 'latin-iso8859-2 42))
104 (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69)))) 105 (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69))))
105 106
107 ;; Test coding system functions
108
109 ;; Create alias for coding system without subsidiaries
110 (Assert (coding-system-p (find-coding-system 'binary)))
111 (Assert (coding-system-canonical-name-p 'binary))
112 (Assert (not (coding-system-alias-p 'binary)))
113 (Assert (not (coding-system-alias-p 'mule-tests-alias)))
114 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
115 (Check-Error-Message
116 error "Symbol is the canonical name of a coding system and cannot be redefined"
117 (define-coding-system-alias 'binary 'iso8859-2))
118 (Check-Error-Message
119 error "Symbol is not a coding system alias"
120 (coding-system-aliasee 'binary))
121
122 (define-coding-system-alias 'mule-tests-alias 'binary)
123 (Assert (coding-system-alias-p 'mule-tests-alias))
124 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
125 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)))
126 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias)))
127 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
128 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos)))
129 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac)))
130
131 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary))
132 (Assert (coding-system-alias-p 'mule-tests-alias))
133 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
134 (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)))
135 (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias)))
136 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
137 (Assert (not (coding-system-alias-p 'mule-tests-alias-dos)))
138 (Assert (not (coding-system-alias-p 'mule-tests-alias-mac)))
139
140 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias)
141 (Assert (coding-system-alias-p 'nested-mule-tests-alias))
142 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias)))
143 (Assert (eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias)))
144 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias))
145 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)))
146 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix)))
147 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos)))
148 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac)))
149
150 (Check-Error-Message
151 error "Attempt to create a coding system alias loop"
152 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias))
153 (Check-Error-Message
154 error "No such coding system"
155 (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system))
156 (Check-Error-Message
157 error "Attempt to create a coding system alias loop"
158 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias))
159
160 (define-coding-system-alias 'nested-mule-tests-alias nil)
161 (define-coding-system-alias 'mule-tests-alias nil)
162 (Assert (coding-system-p (find-coding-system 'binary)))
163 (Assert (coding-system-canonical-name-p 'binary))
164 (Assert (not (coding-system-alias-p 'binary)))
165 (Assert (not (coding-system-alias-p 'mule-tests-alias)))
166 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
167 (Check-Error-Message
168 error "Symbol is the canonical name of a coding system and cannot be redefined"
169 (define-coding-system-alias 'binary 'iso8859-2))
170 (Check-Error-Message
171 error "Symbol is not a coding system alias"
172 (coding-system-aliasee 'binary))
173
174 (define-coding-system-alias 'nested-mule-tests-alias nil)
175 (define-coding-system-alias 'mule-tests-alias nil)
176
177 ;; Create alias for coding system with subsidiaries
178 (define-coding-system-alias 'mule-tests-alias 'iso-8859-7)
179 (Assert (coding-system-alias-p 'mule-tests-alias))
180 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
181 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)))
182 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)))
183 (Assert (coding-system-alias-p 'mule-tests-alias-unix))
184 (Assert (coding-system-alias-p 'mule-tests-alias-dos))
185 (Assert (coding-system-alias-p 'mule-tests-alias-mac))
186
187 (define-coding-system-alias 'mule-tests-alias (get-coding-system 'iso-8859-7))
188 (Assert (coding-system-alias-p 'mule-tests-alias))
189 (Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
190 (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias)))
191 (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)))
192 (Assert (coding-system-alias-p 'mule-tests-alias-unix))
193 (Assert (coding-system-alias-p 'mule-tests-alias-dos))
194 (Assert (coding-system-alias-p 'mule-tests-alias-mac))
195 (Assert (eq (find-coding-system 'mule-tests-alias-mac)
196 (find-coding-system 'iso-8859-7-mac)))
197
198 (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias)
199 (Assert (coding-system-alias-p 'nested-mule-tests-alias))
200 (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias)))
201 (Assert (eq (get-coding-system 'iso-8859-7)
202 (get-coding-system 'nested-mule-tests-alias)))
203 (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias))
204 (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias)))
205 (Assert (coding-system-alias-p 'nested-mule-tests-alias-unix))
206 (Assert (coding-system-alias-p 'nested-mule-tests-alias-dos))
207 (Assert (coding-system-alias-p 'nested-mule-tests-alias-mac))
208 (Assert (eq (find-coding-system 'nested-mule-tests-alias-unix)
209 (find-coding-system 'iso-8859-7-unix)))
210
211 (Check-Error-Message
212 error "Attempt to create a coding system alias loop"
213 (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias))
214 (Check-Error-Message
215 error "No such coding system"
216 (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system))
217 (Check-Error-Message
218 error "Attempt to create a coding system alias loop"
219 (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias))
220
221 ;; Test dangling alias deletion
222 (define-coding-system-alias 'mule-tests-alias nil)
223 (Assert (not (coding-system-alias-p 'mule-tests-alias)))
224 (Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
225 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias)))
226 (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos)))
227
106 ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c) 228 ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c)
107 (defun charset-char-string (charset) 229 (defun charset-char-string (charset)
108 (let (lo hi string n) 230 (let (lo hi string n)
109 (if (= (charset-chars charset) 94) 231 (if (= (charset-chars charset) 94)
110 (setq lo 33 hi 126) 232 (setq lo 33 hi 126)