Mercurial > hg > xemacs-beta

comparison tests/automated/query-coding-tests.el @ 4570:e6a7054a9c30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add check-coding-systems-region, test it and others, fix some bugs. tests/ChangeLog addition: 2008-12-28 Aidan Kehoe <kehoea@parhasard.net> * automated/query-coding-tests.el: Add tests for #'unencodable-char-position, #'check-coding-systems-region, #'encode-coding-char. Remove some debugging statements. lisp/ChangeLog addition: 2008-12-28 Aidan Kehoe <kehoea@parhasard.net> * coding.el (query-coding-region): (query-coding-string): Make these defsubsts, they're short enough and they're called explicitly rarely enough that it make some sense. The alternative would be compiler macros that avoid the binding of the arguments. (unencodable-char-position): Document where the docstring and API are from. Correct a special case for zero--check-argument-type returns nil when it succeeds, we can't usefully chain its result in an and here. (check-coding-systems-region): New. API taken from GNU; docstring and implementation are independent. (encode-coding-char): Add an optional third argument, as used by recent GNU. Document the origen of the docstring. (default-query-coding-region): Add a short docstring to the non-Mule implementation of this function. * unicode.el: Don't set the query-coding-function property for unicode coding systems if we're on non-mule. Unintern unicode-query-coding-region, unicode-query-coding-skip-chars-arg in the same context.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 28 Dec 2008 22:51:14 +0000
parents 1d74a1d115ee
children e0a8715fdb1f
comparison
equal deleted inserted replaced
4569:80e0588fb42f 4570:e6a7054a9c30
89 :test #'eq)) 89 :test #'eq))
90 (q-c-debug "looking at coding system %S" (coding-system-name 90 (q-c-debug "looking at coding system %S" (coding-system-name
91 coding-system)) 91 coding-system))
92 (multiple-value-bind (query-coding-succeeded query-coding-table) 92 (multiple-value-bind (query-coding-succeeded query-coding-table)
93 (query-coding-region (point-min) (point-max) coding-system) 93 (query-coding-region (point-min) (point-max) coding-system)
94 (q-c-debug "checking type, coding-system, q-c-s, q-c-t %S"
95 (list (coding-system-type coding-system)
96 coding-system query-coding-succeeded
97 query-coding-table))
98 (unless (and (eq t query-coding-succeeded)
99 (null query-coding-table))
100 (q-c-debug "(eq t query-coding-succeeded) %S, (\
101 null query-coding-table) %S" (eq t query-coding-succeeded)
102 (null query-coding-table)))
103 (Assert (eq t query-coding-succeeded)) 94 (Assert (eq t query-coding-succeeded))
104 (Assert (null query-coding-table))) 95 (Assert (null query-coding-table)))
105 (q-c-debug "testing the ASCII strings for %S" coding-system)
106 (multiple-value-bind (query-coding-succeeded query-coding-table) 96 (multiple-value-bind (query-coding-succeeded query-coding-table)
107 (query-coding-string ascii-chars-string coding-system) 97 (query-coding-string ascii-chars-string coding-system)
108 (unless (and (eq t query-coding-succeeded)
109 (null query-coding-table))
110 (q-c-debug "(eq t query-coding-succeeded) %S, (\
111 null query-coding-table) %S" (eq t query-coding-succeeded)
112 (null query-coding-table)))
113 (Assert (eq t query-coding-succeeded)) 98 (Assert (eq t query-coding-succeeded))
114 (Assert (null query-coding-table)))) 99 (Assert (null query-coding-table))))
115 (q-c-debug "past the loop through the coding systems")
116 (delete-region (point-min) (point-max)) 100 (delete-region (point-min) (point-max))
117 ;; Check for success from the two Latin-1 coding systems 101 ;; Check for success from the two Latin-1 coding systems
118 (insert latin-1-chars-string) 102 (insert latin-1-chars-string)
119 (q-c-debug "point is now %S" (point))
120 (multiple-value-bind (query-coding-succeeded query-coding-table) 103 (multiple-value-bind (query-coding-succeeded query-coding-table)
121 (query-coding-region (point-min) (point-max) 'iso-8859-1-unix) 104 (query-coding-region (point-min) (point-max) 'iso-8859-1-unix)
122 (Assert (eq t query-coding-succeeded)) 105 (Assert (eq t query-coding-succeeded))
123 (Assert (null query-coding-table))) 106 (Assert (null query-coding-table)))
124 (q-c-debug "point is now %S" (point))
125 (multiple-value-bind (query-coding-succeeded query-coding-table) 107 (multiple-value-bind (query-coding-succeeded query-coding-table)
126 (query-coding-string (buffer-string) 'iso-8859-1-unix) 108 (query-coding-string (buffer-string) 'iso-8859-1-unix)
127 (Assert (eq t query-coding-succeeded)) 109 (Assert (eq t query-coding-succeeded))
128 (Assert (null query-coding-table))) 110 (Assert (null query-coding-table)))
129 (q-c-debug "point is now %S" (point))
130 (multiple-value-bind (query-coding-succeeded query-coding-table) 111 (multiple-value-bind (query-coding-succeeded query-coding-table)
131 (query-coding-string (buffer-string) 'iso-latin-1-with-esc-unix) 112 (query-coding-string (buffer-string) 'iso-latin-1-with-esc-unix)
132 (Assert (eq t query-coding-succeeded)) 113 (Assert (eq t query-coding-succeeded))
133 (Assert (null query-coding-table))) 114 (Assert (null query-coding-table)))
134 (q-c-debug "point is now %S" (point))
135 ;; Make it fail, check that it fails correctly 115 ;; Make it fail, check that it fails correctly
136 (insert (decode-char 'ucs #x20AC)) ;; EURO SIGN 116 (insert (decode-char 'ucs #x20AC)) ;; EURO SIGN
137 (multiple-value-bind (query-coding-succeeded query-coding-table) 117 (multiple-value-bind (query-coding-succeeded query-coding-table)
138 (query-coding-region (point-min) (point-max) 'iso-8859-1-unix) 118 (query-coding-region (point-min) (point-max) 'iso-8859-1-unix)
139 (unless (and (null query-coding-succeeded)
140 (equal query-coding-table
141 #s(range-table type start-closed-end-open data
142 ((257 258) t))))
143 (q-c-debug "dealing with %S" 'iso-8859-1-unix)
144 (q-c-debug "query-coding-succeeded not null, query-coding-table \
145 %S" query-coding-table))
146 (Assert (null query-coding-succeeded)) 119 (Assert (null query-coding-succeeded))
147 (Assert (equal query-coding-table 120 (Assert (equal query-coding-table
148 #s(range-table type start-closed-end-open data 121 #s(range-table type start-closed-end-open data
149 ((257 258) t))))) 122 ((257 258) t)))))
150 (multiple-value-bind (query-coding-succeeded query-coding-table) 123 (multiple-value-bind (query-coding-succeeded query-coding-table)
151 (query-coding-region (point-min) (point-max) 124 (query-coding-region (point-min) (point-max)
152 'iso-latin-1-with-esc-unix) 125 'iso-latin-1-with-esc-unix)
153 ;; Stupidly, this succeeds. The behaviour is compatible with 126 ;; Stupidly, this succeeds. The behaviour is compatible with
154 ;; GNU, though, and we encourage people not to use 127 ;; GNU, though, and we encourage people not to use
155 ;; iso-latin-1-with-esc-unix anyway: 128 ;; iso-latin-1-with-esc-unix anyway:
156
157 (unless (and query-coding-succeeded
158 (null query-coding-table))
159 (q-c-debug "dealing with %S" 'iso-latin-1-with-esc-unix)
160 (q-c-debug "query-coding-succeeded %S, query-coding-table \
161 %S" query-coding-succeeded query-coding-table))
162 (Assert query-coding-succeeded) 129 (Assert query-coding-succeeded)
163 (Assert (null query-coding-table))) 130 (Assert (null query-coding-table)))
164 ;; Check that it errors correctly. 131 ;; Check that it errors correctly.
165 (setq text-conversion-error-signalled nil) 132 (setq text-conversion-error-signalled nil)
166 (condition-case nil 133 (condition-case nil
184 (Assert (eq t query-coding-succeeded)) 151 (Assert (eq t query-coding-succeeded))
185 (Assert (null query-coding-table))) 152 (Assert (null query-coding-table)))
186 (insert ?\x80) 153 (insert ?\x80)
187 (multiple-value-bind (query-coding-succeeded query-coding-table) 154 (multiple-value-bind (query-coding-succeeded query-coding-table)
188 (query-coding-region (point-min) (point-max) 'windows-1252-unix) 155 (query-coding-region (point-min) (point-max) 'windows-1252-unix)
189 (unless (and (null query-coding-succeeded)
190 (equal query-coding-table
191 #s(range-table type start-closed-end-open data
192 ((257 258) t))))
193 (q-c-debug "dealing with %S" 'windows-1252-unix)
194 (q-c-debug "query-coding-succeeded not null, query-coding-table \
195 %S" query-coding-table))
196 (Assert (null query-coding-succeeded)) 156 (Assert (null query-coding-succeeded))
197 (Assert (equal query-coding-table 157 (Assert (equal query-coding-table
198 #s(range-table type start-closed-end-open data 158 #s(range-table type start-closed-end-open data
199 ((257 258) t))))) 159 ((257 258) t)))))
200 ;; Try a similar approach with koi8-o, the koi8 variant with 160 ;; Try a similar approach with koi8-o, the koi8 variant with
210 (query-coding-region (point-min) (point-max) 'escape-quoted) 170 (query-coding-region (point-min) (point-max) 'escape-quoted)
211 (Assert (eq t query-coding-succeeded)) 171 (Assert (eq t query-coding-succeeded))
212 (Assert (null query-coding-table))) 172 (Assert (null query-coding-table)))
213 (multiple-value-bind (query-coding-succeeded query-coding-table) 173 (multiple-value-bind (query-coding-succeeded query-coding-table)
214 (query-coding-region (point-min) (point-max) 'windows-1252-unix) 174 (query-coding-region (point-min) (point-max) 'windows-1252-unix)
215 (unless (and (null query-coding-succeeded)
216 (equal query-coding-table
217 #s(range-table type start-closed-end-open
218 data ((129 131) t (132 133) t
219 (139 140) t (141 146) t
220 (155 156) t (157 161) t
221 (162 170) t (173 176) t
222 (178 187) t (189 192) t
223 (193 257) t))))
224 (q-c-debug "query-coding-succeeded not null, query-coding-table \
225 %S" query-coding-table))
226 (Assert (null query-coding-succeeded)) 175 (Assert (null query-coding-succeeded))
227 (Assert (equal query-coding-table 176 (Assert (equal query-coding-table
228 #s(range-table type start-closed-end-open 177 #s(range-table type start-closed-end-open
229 data ((129 131) t (132 133) t (139 140) t 178 data ((129 131) t (132 133) t (139 140) t
230 (141 146) t (155 156) t (157 161) t 179 (141 146) t (155 156) t (157 161) t
288 (setq text-conversion-error-signalled nil) 237 (setq text-conversion-error-signalled nil)
289 (condition-case nil 238 (condition-case nil
290 (query-coding-region (point-min) 173 coding-system nil t) 239 (query-coding-region (point-min) 173 coding-system nil t)
291 (text-conversion-error 240 (text-conversion-error
292 (setq text-conversion-error-signalled t))) 241 (setq text-conversion-error-signalled t)))
293 (Assert (null text-conversion-error-signalled)))))) 242 (Assert (null text-conversion-error-signalled)))
243
244 ;; Now to test #'encode-coding-char. Most of the functionality was
245 ;; tested in the query-coding-region tests above, so we don't go into
246 ;; as much detail here.
247 (Assert (null (encode-coding-char
248 (decode-char 'ucs #x20ac) 'iso-8859-1)))
249 (Assert (equal "\x80" (encode-coding-char
250 (decode-char 'ucs #x20ac) 'windows-1252)))
251 (delete-region (point-min) (point-max))
252
253 ;; And #'unencodable-char-position.
254 (insert latin-1-chars-string)
255 (insert (decode-char 'ucs #x20ac))
256 (Assert (= 257 (unencodable-char-position (point-min) (point-max)
257 'iso-8859-1)))
258 (Assert (equal '(257) (unencodable-char-position (point-min) (point-max)
259 'iso-8859-1 1)))
260 ;; Compatiblity, sigh:
261 (Assert (equal '(257) (unencodable-char-position (point-min) (point-max)
262 'iso-8859-1 0)))
263 (dotimes (i 6) (insert (decode-char 'ucs #x20ac)))
264 ;; Check if it stops at one:
265 (Assert (equal '(257) (unencodable-char-position (point-min) (point-max)
266 'iso-8859-1 1)))
267 ;; Check if it stops at four:
268 (Assert (equal '(260 259 258 257)
269 (unencodable-char-position (point-min) (point-max)
270 'iso-8859-1 4)))
271 ;; Check whether it stops at seven:
272 (Assert (equal '(263 262 261 260 259 258 257)
273 (unencodable-char-position (point-min) (point-max)
274 'iso-8859-1 7)))
275 ;; Check that it still stops at seven:
276 (Assert (equal '(263 262 261 260 259 258 257)
277 (unencodable-char-position (point-min) (point-max)
278 'iso-8859-1 2000)))
279 ;; Now, #'check-coding-systems-region.
280 ;; UTF-8 should certainly be able to encode these characters:
281 (Assert (eq t (check-coding-systems-region (point-min) (point-max)
282 '(utf-8))))
283 (Assert (equal '((iso-8859-1 257 258 259 260 261 262 263)
284 (windows-1252 129 131 132 133 134 135 136 137 138 139
285 140 141 143 146 147 148 149 150 151 152
286 153 154 155 156 157 159 160))
287 (sort
288 (check-coding-systems-region (point-min) (point-max)
289 '(utf-8 iso-8859-1
290 windows-1252))
291 ;; (The sort is to make the algorithm irrelevant.)
292 #'(lambda (left right)
293 (string< (car left) (car right))))))
294 ;; Ensure that the indices are all decreased by one when passed a
295 ;; string:
296 (Assert (equal '((iso-8859-1 256 257 258 259 260 261 262)
297 (windows-1252 128 130 131 132 133 134 135 136 137 138
298 139 140 142 145 146 147 148 149 150 151
299 152 153 154 155 156 158 159))
300 (sort
301 (check-coding-systems-region (buffer-string) nil
302 '(utf-8 iso-8859-1
303 windows-1252))
304 #'(lambda (left right)
305 (string< (car left) (car right)))))))))
306