|
398
|
1 /* C support for testing XEmacs - see tests/automated/c-tests.el
|
|
|
2 Copyright (C) 2000 Martin Buchholz
|
|
771
|
3 Copyright (C) 2001, 2002 Ben Wing.
|
|
3417
|
4 Copyright (C) 2006 The Free Software Foundation, Inc.
|
|
398
|
5
|
|
|
6 This file is part of XEmacs.
|
|
|
7
|
|
|
8 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
9 under the terms of the GNU General Public License as published by the
|
|
|
10 Free Software Foundation; either version 2, or (at your option) any
|
|
|
11 later version.
|
|
|
12
|
|
|
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
16 for more details.
|
|
|
17
|
|
|
18 You should have received a copy of the GNU General Public License
|
|
|
19 along with XEmacs; see the file COPYING. If not, write to
|
|
|
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
21 Boston, MA 02111-1307, USA. */
|
|
|
22
|
|
|
23 /* Author: Martin Buchholz
|
|
|
24
|
|
|
25 This file provides support for running tests for XEmacs that cannot
|
|
|
26 be written entirely in Lisp. These tests are run automatically via
|
|
|
27 tests/automated/c-tests.el, or can be run by hand using M-x */
|
|
|
28
|
|
|
29
|
|
|
30 #include <config.h>
|
|
|
31 #include "lisp.h"
|
|
|
32 #include "buffer.h"
|
|
|
33 #include "lstream.h"
|
|
489
|
34 #include "elhash.h"
|
|
398
|
35 #include "opaque.h"
|
|
3417
|
36 #include "file-coding.h" /* XCODING_SYSTEM_EOL_TYPE and its values */
|
|
398
|
37
|
|
|
38 static Lisp_Object Vtest_function_list;
|
|
|
39
|
|
|
40
|
|
|
41 DEFUN ("test-data-format-conversion", Ftest_data_format_conversion, 0, 0, "", /*
|
|
|
42 Test TO_EXTERNAL_FORMAT() and TO_INTERNAL_FORMAT()
|
|
|
43 */
|
|
|
44 ())
|
|
|
45 {
|
|
665
|
46 void *ptr; Bytecount len;
|
|
398
|
47 Lisp_Object string, opaque;
|
|
|
48
|
|
867
|
49 Ibyte int_foo[] = "\n\nfoo\nbar";
|
|
398
|
50 Extbyte ext_unix[]= "\n\nfoo\nbar";
|
|
|
51
|
|
|
52 Extbyte ext_dos[] = "\r\n\r\nfoo\r\nbar";
|
|
|
53 Extbyte ext_mac[] = "\r\rfoo\rbar";
|
|
|
54 Lisp_Object opaque_dos = make_opaque (ext_dos, sizeof (ext_dos) - 1);
|
|
|
55 Lisp_Object string_foo = make_string (int_foo, sizeof (int_foo) - 1);
|
|
|
56
|
|
|
57 Extbyte ext_latin[] = "f\372b\343\340";
|
|
867
|
58 Ibyte int_latin1[] = "f\200\372b\200\343\200\340";
|
|
|
59 Ibyte int_latin2[] = "f\201\372b\201\343\201\340";
|
|
398
|
60 #ifdef MULE
|
|
|
61 Extbyte ext_latin12[]= "f\033-A\372b\343\340\033-B";
|
|
|
62 Extbyte ext_tilde[] = "f~b~~";
|
|
|
63 Lisp_Object string_latin2 = make_string (int_latin2, sizeof (int_latin2) - 1);
|
|
|
64 #endif
|
|
|
65 Lisp_Object opaque_latin = make_opaque (ext_latin, sizeof (ext_latin) - 1);
|
|
|
66 Lisp_Object opaque0_latin = make_opaque (ext_latin, sizeof (ext_latin));
|
|
|
67 Lisp_Object string_latin1 = make_string (int_latin1, sizeof (int_latin1) - 1);
|
|
3417
|
68 int autodetect_eol_p =
|
|
|
69 !NILP (Fsymbol_value (intern ("eol-detection-enabled-p")));
|
|
398
|
70
|
|
|
71 /* Check for expected strings before and after conversion.
|
|
771
|
72 Conversions depend on whether MULE is defined. */
|
|
398
|
73 #ifdef MULE
|
|
|
74 #define DFC_CHECK_DATA_COND_MULE(ptr,len, \
|
|
|
75 constant_string_mule, \
|
|
|
76 constant_string_non_mule) \
|
|
|
77 DFC_CHECK_DATA (ptr, len, constant_string_mule)
|
|
|
78 #define DFC_CHECK_DATA_COND_MULE_NUL(ptr,len, \
|
|
|
79 constant_string_mule, \
|
|
|
80 constant_string_non_mule) \
|
|
|
81 DFC_CHECK_DATA_NUL (ptr, len, constant_string_mule)
|
|
|
82 #else
|
|
|
83 #define DFC_CHECK_DATA_COND_MULE(ptr,len, \
|
|
|
84 constant_string_mule, \
|
|
|
85 constant_string_non_mule) \
|
|
|
86 DFC_CHECK_DATA (ptr, len, constant_string_non_mule)
|
|
|
87 #define DFC_CHECK_DATA_COND_MULE_NUL(ptr,len, \
|
|
|
88 constant_string_mule, \
|
|
|
89 constant_string_non_mule) \
|
|
|
90 DFC_CHECK_DATA_NUL (ptr, len, constant_string_non_mule)
|
|
|
91 #endif
|
|
|
92
|
|
3417
|
93 /* These now only apply to base coding systems, and
|
|
|
94 need to test `eol-detection-enabled-p' at runtime. */
|
|
398
|
95 #define DFC_CHECK_DATA_COND_EOL(ptr,len, \
|
|
3417
|
96 constant_string_eol, \
|
|
|
97 constant_string_non_eol) do { \
|
|
|
98 if (autodetect_eol_p) \
|
|
|
99 DFC_CHECK_DATA (ptr, len, constant_string_eol); \
|
|
|
100 else \
|
|
|
101 DFC_CHECK_DATA (ptr, len, constant_string_non_eol); \
|
|
|
102 } while (0)
|
|
398
|
103 #define DFC_CHECK_DATA_COND_EOL_NUL(ptr,len, \
|
|
3417
|
104 constant_string_eol, \
|
|
|
105 constant_string_non_eol) do { \
|
|
|
106 if (autodetect_eol_p) \
|
|
|
107 DFC_CHECK_DATA_NUL (ptr, len, constant_string_eol); \
|
|
|
108 else \
|
|
|
109 DFC_CHECK_DATA_NUL (ptr, len, constant_string_non_eol); \
|
|
|
110 } while (0)
|
|
398
|
111
|
|
|
112 /* Check for expected strings before and after conversion. */
|
|
|
113 #define DFC_CHECK_DATA(ptr,len, constant_string) do { \
|
|
|
114 assert ((len) == sizeof (constant_string) - 1); \
|
|
|
115 assert (!memcmp (ptr, constant_string, len)); \
|
|
|
116 } while (0)
|
|
|
117
|
|
|
118 /* Macro version that includes the trailing NULL byte. */
|
|
|
119 #define DFC_CHECK_DATA_NUL(ptr,len,constant_string) do {\
|
|
|
120 assert ((len) == sizeof (constant_string)); \
|
|
|
121 assert (!memcmp (ptr, constant_string, len)); \
|
|
|
122 } while (0)
|
|
|
123
|
|
|
124 #ifdef MULE
|
|
|
125 ptr = NULL, len = rand();
|
|
|
126 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)),
|
|
|
127 ALLOCA, (ptr, len),
|
|
771
|
128 intern ("iso-8859-2"));
|
|
398
|
129 DFC_CHECK_DATA_NUL (ptr, len, ext_latin);
|
|
|
130
|
|
|
131 ptr = NULL, len = rand();
|
|
|
132 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin2,
|
|
|
133 ALLOCA, (ptr, len),
|
|
771
|
134 intern ("iso-8859-2"));
|
|
398
|
135 DFC_CHECK_DATA (ptr, len, ext_latin);
|
|
|
136
|
|
|
137 ptr = NULL, len = rand();
|
|
|
138 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1,
|
|
|
139 ALLOCA, (ptr, len),
|
|
771
|
140 intern ("iso-8859-2"));
|
|
398
|
141 DFC_CHECK_DATA (ptr, len, ext_latin12);
|
|
|
142
|
|
|
143 ptr = NULL, len = rand();
|
|
|
144 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1),
|
|
|
145 MALLOC, (ptr, len),
|
|
771
|
146 intern ("iso-8859-2"));
|
|
398
|
147 DFC_CHECK_DATA (ptr, len, ext_latin);
|
|
1726
|
148 xfree (ptr, void *);
|
|
398
|
149
|
|
|
150 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1),
|
|
|
151 LISP_OPAQUE, opaque,
|
|
771
|
152 intern ("iso-8859-2"));
|
|
398
|
153 DFC_CHECK_DATA (XOPAQUE_DATA (opaque), XOPAQUE_SIZE (opaque), ext_latin);
|
|
|
154
|
|
|
155 ptr = NULL, len = rand();
|
|
|
156 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
|
|
|
157 ALLOCA, (ptr, len),
|
|
|
158 intern ("iso-8859-2"));
|
|
|
159 DFC_CHECK_DATA (ptr, len, int_latin2);
|
|
|
160
|
|
|
161 ptr = NULL, len = rand();
|
|
|
162 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
|
|
|
163 MALLOC, (ptr, len),
|
|
|
164 intern ("iso-8859-2"));
|
|
|
165 DFC_CHECK_DATA (ptr, len, int_latin2);
|
|
1726
|
166 xfree (ptr, void *);
|
|
398
|
167
|
|
|
168 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
|
|
|
169 LISP_STRING, string,
|
|
|
170 intern ("iso-8859-2"));
|
|
|
171 DFC_CHECK_DATA (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2);
|
|
|
172
|
|
|
173 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin,
|
|
|
174 LISP_STRING, string,
|
|
|
175 intern ("iso-8859-2"));
|
|
|
176 DFC_CHECK_DATA (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2);
|
|
|
177
|
|
|
178 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin,
|
|
|
179 LISP_STRING, string,
|
|
|
180 intern ("iso-8859-2"));
|
|
|
181 DFC_CHECK_DATA_NUL (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2);
|
|
|
182
|
|
|
183 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin,
|
|
|
184 LISP_BUFFER, Fcurrent_buffer(),
|
|
|
185 intern ("iso-8859-2"));
|
|
|
186 DFC_CHECK_DATA_NUL (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)),
|
|
|
187 sizeof (int_latin2), int_latin2);
|
|
|
188
|
|
|
189 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin,
|
|
|
190 LISP_BUFFER, Fcurrent_buffer(),
|
|
|
191 intern ("iso-8859-1"));
|
|
|
192 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)),
|
|
|
193 sizeof (int_latin1) - 1, int_latin1);
|
|
|
194
|
|
|
195 TO_INTERNAL_FORMAT (DATA, (ext_latin12, sizeof (ext_latin12) - 1),
|
|
|
196 ALLOCA, (ptr, len),
|
|
|
197 intern ("iso-8859-2"));
|
|
|
198 DFC_CHECK_DATA (ptr, len, int_latin1);
|
|
|
199
|
|
|
200 #endif /* MULE */
|
|
|
201
|
|
|
202 ptr = NULL, len = rand();
|
|
|
203 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
|
|
|
204 ALLOCA, (ptr, len),
|
|
|
205 Qbinary);
|
|
|
206 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1);
|
|
|
207
|
|
|
208 ptr = NULL, len = rand();
|
|
|
209 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1)),
|
|
|
210 ALLOCA, (ptr, len),
|
|
|
211 Qbinary);
|
|
|
212 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, ext_latin, int_latin1);
|
|
|
213
|
|
|
214 ptr = NULL, len = rand();
|
|
|
215 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1),
|
|
|
216 ALLOCA, (ptr, len),
|
|
771
|
217 Qbinary);
|
|
398
|
218 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_tilde, int_latin2);
|
|
|
219
|
|
|
220 ptr = NULL, len = rand();
|
|
|
221 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
|
|
|
222 ALLOCA, (ptr, len),
|
|
|
223 intern ("iso-8859-1"));
|
|
|
224 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1);
|
|
|
225
|
|
|
226
|
|
|
227 ptr = NULL, len = rand();
|
|
|
228 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1,
|
|
|
229 ALLOCA, (ptr, len),
|
|
|
230 Qbinary);
|
|
|
231 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1);
|
|
|
232
|
|
|
233 ptr = NULL, len = rand();
|
|
|
234 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1,
|
|
|
235 ALLOCA, (ptr, len),
|
|
771
|
236 Qbinary);
|
|
398
|
237 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1);
|
|
|
238
|
|
|
239 ptr = NULL, len = rand();
|
|
|
240 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1,
|
|
|
241 ALLOCA, (ptr, len),
|
|
|
242 intern ("iso-8859-1"));
|
|
|
243 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1);
|
|
|
244
|
|
|
245 ptr = NULL, len = rand();
|
|
|
246 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
|
|
|
247 MALLOC, (ptr, len),
|
|
|
248 Qbinary);
|
|
|
249 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1);
|
|
1726
|
250 xfree (ptr, void *);
|
|
398
|
251
|
|
|
252 ptr = NULL, len = rand();
|
|
|
253 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)),
|
|
|
254 MALLOC, (ptr, len),
|
|
771
|
255 Qbinary);
|
|
398
|
256 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, ext_tilde, int_latin2);
|
|
1726
|
257 xfree (ptr, void *);
|
|
398
|
258
|
|
|
259 ptr = NULL, len = rand();
|
|
|
260 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
|
|
|
261 MALLOC, (ptr, len),
|
|
|
262 intern ("iso-8859-1"));
|
|
|
263 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1);
|
|
1726
|
264 xfree (ptr, void *);
|
|
398
|
265
|
|
|
266 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
|
|
|
267 LISP_OPAQUE, opaque,
|
|
|
268 Qbinary);
|
|
|
269 DFC_CHECK_DATA_COND_MULE (XOPAQUE_DATA (opaque),
|
|
|
270 XOPAQUE_SIZE (opaque), ext_latin, int_latin1);
|
|
|
271
|
|
|
272 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)),
|
|
|
273 LISP_OPAQUE, opaque,
|
|
771
|
274 Qbinary);
|
|
398
|
275 DFC_CHECK_DATA_COND_MULE_NUL (XOPAQUE_DATA (opaque),
|
|
|
276 XOPAQUE_SIZE (opaque), ext_tilde, int_latin2);
|
|
|
277
|
|
|
278 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
|
|
|
279 LISP_OPAQUE, opaque,
|
|
|
280 intern ("iso-8859-1"));
|
|
|
281 DFC_CHECK_DATA_COND_MULE (XOPAQUE_DATA (opaque),
|
|
|
282 XOPAQUE_SIZE (opaque), ext_latin, int_latin1);
|
|
|
283
|
|
|
284 ptr = NULL, len = rand();
|
|
|
285 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
|
|
|
286 ALLOCA, (ptr, len),
|
|
|
287 Qbinary);
|
|
|
288 DFC_CHECK_DATA_COND_MULE (ptr, len, int_latin1, ext_latin);
|
|
|
289
|
|
|
290 ptr = NULL, len = rand();
|
|
|
291 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)),
|
|
|
292 ALLOCA, (ptr, len),
|
|
|
293 intern ("iso-8859-1"));
|
|
|
294 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin);
|
|
|
295
|
|
|
296 ptr = NULL, len = rand();
|
|
|
297 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)),
|
|
|
298 MALLOC, (ptr, len),
|
|
|
299 intern ("iso-8859-1"));
|
|
|
300 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin);
|
|
1726
|
301 xfree (ptr, void *);
|
|
398
|
302
|
|
|
303 ptr = NULL, len = rand();
|
|
|
304 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)),
|
|
|
305 MALLOC, (ptr, len),
|
|
|
306 Qnil);
|
|
|
307 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin);
|
|
1726
|
308 xfree (ptr, void *);
|
|
398
|
309
|
|
|
310 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
|
|
|
311 LISP_STRING, string,
|
|
|
312 intern ("iso-8859-1"));
|
|
|
313 DFC_CHECK_DATA_COND_MULE (XSTRING_DATA (string),
|
|
|
314 XSTRING_LENGTH (string), int_latin1, ext_latin);
|
|
|
315
|
|
|
316 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin,
|
|
|
317 LISP_STRING, string,
|
|
|
318 intern ("iso-8859-1"));
|
|
|
319 DFC_CHECK_DATA_COND_MULE (XSTRING_DATA (string),
|
|
|
320 XSTRING_LENGTH (string), int_latin1, ext_latin);
|
|
|
321
|
|
|
322 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin,
|
|
|
323 LISP_STRING, string,
|
|
|
324 intern ("iso-8859-1"));
|
|
|
325 DFC_CHECK_DATA_COND_MULE_NUL (XSTRING_DATA (string),
|
|
|
326 XSTRING_LENGTH (string), int_latin1, ext_latin);
|
|
|
327
|
|
3417
|
328 /* This next group used to use the COND_EOL macros, but with the new Mule,
|
|
|
329 they all specify an EOL convention, and all XEmacsen can grok them. */
|
|
398
|
330 ptr = NULL, len = rand();
|
|
|
331 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo)),
|
|
|
332 MALLOC, (ptr, len),
|
|
771
|
333 Qbinary);
|
|
3417
|
334 DFC_CHECK_DATA_NUL (ptr, len, ext_unix);
|
|
1726
|
335 xfree (ptr, void *);
|
|
398
|
336
|
|
|
337 ptr = NULL, len = rand();
|
|
|
338 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1),
|
|
|
339 LISP_OPAQUE, opaque,
|
|
|
340 intern ("raw-text-mac"));
|
|
3417
|
341 DFC_CHECK_DATA (XOPAQUE_DATA (opaque), XOPAQUE_SIZE (opaque), ext_mac);
|
|
398
|
342
|
|
|
343 ptr = NULL, len = rand();
|
|
|
344 TO_EXTERNAL_FORMAT (LISP_STRING, string_foo,
|
|
|
345 ALLOCA, (ptr, len),
|
|
|
346 intern ("raw-text-dos"));
|
|
3417
|
347 DFC_CHECK_DATA (ptr, len, ext_dos);
|
|
398
|
348
|
|
|
349 ptr = NULL, len = rand();
|
|
|
350 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1),
|
|
|
351 ALLOCA, (ptr, len),
|
|
|
352 intern ("raw-text-unix"));
|
|
3417
|
353 DFC_CHECK_DATA (ptr, len, ext_unix);
|
|
398
|
354
|
|
|
355 ptr = NULL, len = rand();
|
|
|
356 TO_EXTERNAL_FORMAT (LISP_STRING, string_foo,
|
|
|
357 MALLOC, (ptr, len),
|
|
|
358 intern ("no-conversion-mac"));
|
|
3417
|
359 DFC_CHECK_DATA (ptr, len, ext_mac);
|
|
1726
|
360 xfree (ptr, void *);
|
|
398
|
361
|
|
|
362 ptr = NULL, len = rand();
|
|
|
363 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1),
|
|
|
364 ALLOCA, (ptr, len),
|
|
771
|
365 intern ("no-conversion-dos"));
|
|
3417
|
366 DFC_CHECK_DATA (ptr, len, ext_dos);
|
|
398
|
367
|
|
|
368 ptr = NULL, len = rand();
|
|
|
369 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo)),
|
|
|
370 ALLOCA, (ptr, len),
|
|
|
371 intern ("no-conversion-unix"));
|
|
3417
|
372 DFC_CHECK_DATA_NUL (ptr, len, ext_unix);
|
|
|
373
|
|
|
374 /* Oh, Lawdy, Lawdy, Lawdy, this done broke mah heart!
|
|
|
375
|
|
|
376 I tried using the technique
|
|
|
377
|
|
|
378 Fget_coding_system (call2
|
|
|
379 (intern ("coding-system-change-eol-conversion"),
|
|
|
380 intern ("undecided"), $EOL_TYPE));
|
|
|
381 XCODING_SYSTEM_EOL_TYPE (cs_to_use) = $EOL_DETECT_TYPE;
|
|
|
382
|
|
|
383 with EOL_TYPE = Qlf (for no-detect) and Qnil (for auto-detect),
|
|
|
384 and with EOL_DETECT_TYPE = EOL_LF and EOL_AUTODETECT
|
|
|
385 respectively, but this doesn't seem to work on the `undecided'
|
|
|
386 coding system. The coding-system-eol-type attribute on the
|
|
|
387 coding system itself needs to be changed, too. I'm not sure at
|
|
|
388 the moment how `set-eol-detection' works its magic, but the code
|
|
|
389 below gives correct test results without default EOL detection,
|
|
|
390 with default EOL detection, and with Mule. Ship it!
|
|
|
391
|
|
|
392 Mule. You'll envy the dead.
|
|
|
393 */
|
|
398
|
394
|
|
3417
|
395 {
|
|
|
396 /* Check eol autodetection doesn't happen when disabled -- cheat. */
|
|
|
397 Lisp_Object cs_to_use = Fget_coding_system (intern ("undecided-unix"));
|
|
|
398 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos,
|
|
|
399 LISP_BUFFER, Fcurrent_buffer(),
|
|
|
400 cs_to_use);
|
|
|
401 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)),
|
|
|
402 sizeof (ext_dos) - 1, ext_dos);
|
|
|
403
|
|
|
404 /* Check eol autodetection works when enabled -- honest. */
|
|
|
405 cs_to_use =
|
|
|
406 Fget_coding_system (call2
|
|
|
407 (intern ("coding-system-change-eol-conversion"),
|
|
|
408 intern ("undecided"), Qnil));
|
|
|
409 XCODING_SYSTEM_EOL_TYPE (cs_to_use) = EOL_AUTODETECT;
|
|
|
410 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos,
|
|
|
411 LISP_BUFFER, Fcurrent_buffer(),
|
|
|
412 cs_to_use);
|
|
|
413 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)),
|
|
|
414 sizeof (int_foo) - 1, int_foo);
|
|
|
415 /* reset to default */
|
|
|
416 XCODING_SYSTEM_EOL_TYPE (cs_to_use) =
|
|
|
417 autodetect_eol_p ? EOL_AUTODETECT : EOL_LF;
|
|
|
418 }
|
|
|
419
|
|
|
420 /* Does eol-detection-enabled-p reflect the actual state of affairs?
|
|
|
421 This probably could be tested in Lisp somehow. Should it? */
|
|
398
|
422 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos,
|
|
|
423 LISP_BUFFER, Fcurrent_buffer(),
|
|
|
424 intern ("undecided"));
|
|
3417
|
425 if (autodetect_eol_p)
|
|
|
426 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer,
|
|
|
427 BUF_PT (current_buffer)),
|
|
|
428 sizeof (int_foo) - 1, int_foo);
|
|
|
429 else
|
|
|
430 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer,
|
|
|
431 BUF_PT (current_buffer)),
|
|
|
432 sizeof (ext_dos) - 1, ext_dos);
|
|
398
|
433
|
|
|
434 TO_INTERNAL_FORMAT (DATA, (ext_mac, sizeof (ext_mac) - 1),
|
|
|
435 LISP_STRING, string,
|
|
|
436 intern ("iso-8859-1"));
|
|
|
437 DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string),
|
|
|
438 XSTRING_LENGTH (string), int_foo, ext_mac);
|
|
|
439
|
|
|
440 {
|
|
|
441 Lisp_Object stream =
|
|
|
442 make_fixed_buffer_input_stream (ext_dos, sizeof (ext_dos) - 1);
|
|
|
443 TO_INTERNAL_FORMAT (LISP_LSTREAM, stream,
|
|
|
444 LISP_STRING, string,
|
|
|
445 intern ("iso-8859-1"));
|
|
|
446 DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string),
|
|
|
447 XSTRING_LENGTH (string), int_foo, ext_dos);
|
|
|
448 }
|
|
|
449
|
|
|
450 TO_INTERNAL_FORMAT (DATA, (ext_unix, sizeof (ext_unix) - 1),
|
|
|
451 LISP_STRING, string,
|
|
|
452 intern ("no-conversion"));
|
|
|
453 DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string),
|
|
|
454 XSTRING_LENGTH (string), int_foo, ext_unix);
|
|
|
455
|
|
|
456
|
|
|
457 ptr = NULL, len = rand();
|
|
|
458 TO_EXTERNAL_FORMAT (LISP_OPAQUE, opaque_dos,
|
|
|
459 ALLOCA, (ptr, len),
|
|
|
460 Qbinary);
|
|
|
461 DFC_CHECK_DATA (ptr, len, ext_dos);
|
|
|
462
|
|
|
463 return intern ("PASS");
|
|
|
464 }
|
|
|
465
|
|
|
466
|
|
489
|
467 /* Hash Table testing */
|
|
|
468
|
|
|
469 typedef struct
|
|
|
470 {
|
|
|
471 Lisp_Object hash_table;
|
|
|
472 EMACS_INT sum;
|
|
|
473 } test_hash_tables_data;
|
|
|
474
|
|
|
475
|
|
|
476 static int
|
|
2286
|
477 test_hash_tables_mapper (Lisp_Object UNUSED (key), Lisp_Object value,
|
|
489
|
478 void *extra_arg)
|
|
|
479 {
|
|
|
480 test_hash_tables_data *p = (test_hash_tables_data *) extra_arg;
|
|
|
481 p->sum += XINT (value);
|
|
|
482 return 0;
|
|
|
483 }
|
|
|
484
|
|
|
485 static int
|
|
|
486 test_hash_tables_modifying_mapper (Lisp_Object key, Lisp_Object value,
|
|
|
487 void *extra_arg)
|
|
|
488 {
|
|
|
489 test_hash_tables_data *p = (test_hash_tables_data *) extra_arg;
|
|
|
490 Fputhash (make_int (- XINT (key)),
|
|
|
491 make_int (2 * XINT (value)),
|
|
|
492 p->hash_table);
|
|
|
493 p->sum += XINT (value);
|
|
|
494 return 0;
|
|
|
495 }
|
|
|
496
|
|
|
497 static int
|
|
2286
|
498 test_hash_tables_predicate (Lisp_Object key,
|
|
|
499 Lisp_Object UNUSED (value),
|
|
|
500 void *UNUSED (extra_arg))
|
|
489
|
501 {
|
|
|
502 return XINT (key) < 0;
|
|
|
503 }
|
|
|
504
|
|
|
505
|
|
|
506 DEFUN ("test-hash-tables", Ftest_hash_tables, 0, 0, "", /*
|
|
|
507 Test C interface to hash tables.
|
|
|
508 */
|
|
|
509 ())
|
|
|
510 {
|
|
|
511 test_hash_tables_data data;
|
|
|
512 data.hash_table = make_lisp_hash_table (50, HASH_TABLE_NON_WEAK,
|
|
|
513 HASH_TABLE_EQUAL);
|
|
|
514
|
|
|
515 Fputhash (make_int (1), make_int (2), data.hash_table);
|
|
|
516 Fputhash (make_int (3), make_int (4), data.hash_table);
|
|
|
517
|
|
|
518 data.sum = 0;
|
|
|
519 elisp_maphash_unsafe (test_hash_tables_mapper,
|
|
|
520 data.hash_table, (void *) &data);
|
|
|
521 assert (data.sum == 2 + 4);
|
|
|
522
|
|
|
523 data.sum = 0;
|
|
|
524 elisp_maphash (test_hash_tables_modifying_mapper,
|
|
|
525 data.hash_table, (void *) &data);
|
|
|
526 assert (data.sum == 2 + 4);
|
|
|
527
|
|
|
528 /* hash table now contains: (1, 2) (3, 4) (-1, 2*2) (-3, 2*4) */
|
|
|
529
|
|
|
530 data.sum = 0;
|
|
|
531 elisp_maphash_unsafe (test_hash_tables_mapper,
|
|
|
532 data.hash_table, (void *) &data);
|
|
|
533 assert (data.sum == 3 * (2 + 4));
|
|
|
534
|
|
|
535 /* Remove entries with negative keys, added by modifying mapper */
|
|
|
536 elisp_map_remhash (test_hash_tables_predicate,
|
|
|
537 data.hash_table, 0);
|
|
|
538
|
|
|
539 data.sum = 0;
|
|
|
540 elisp_maphash_unsafe (test_hash_tables_mapper,
|
|
|
541 data.hash_table, (void *) &data);
|
|
|
542 assert (data.sum == 2 + 4);
|
|
|
543
|
|
|
544 return intern ("PASS");
|
|
|
545 }
|
|
|
546
|
|
|
547
|
|
398
|
548
|
|
3263
|
549 #ifdef NEW_GC
|
|
2720
|
550 #define TESTS_DEFSUBR(Fname) do { \
|
|
|
551 DEFSUBR_MC_ALLOC (Fname); \
|
|
|
552 defsubr (S##Fname); \
|
|
|
553 Vtest_function_list = \
|
|
|
554 Fcons (intern (subr_name (S##Fname)), \
|
|
|
555 Vtest_function_list); \
|
|
|
556 } while (0)
|
|
3263
|
557 #else /* not NEW_GC */
|
|
398
|
558 #define TESTS_DEFSUBR(Fname) do { \
|
|
|
559 DEFSUBR (Fname); \
|
|
|
560 Vtest_function_list = \
|
|
|
561 Fcons (intern (subr_name (&S##Fname)), \
|
|
|
562 Vtest_function_list); \
|
|
|
563 } while (0)
|
|
3263
|
564 #endif /* not NEW_GC */
|
|
398
|
565
|
|
|
566 void
|
|
|
567 syms_of_tests (void)
|
|
|
568 {
|
|
|
569 Vtest_function_list = Qnil;
|
|
|
570
|
|
|
571 TESTS_DEFSUBR (Ftest_data_format_conversion);
|
|
489
|
572 TESTS_DEFSUBR (Ftest_hash_tables);
|
|
398
|
573 /* Add other test functions here with TESTS_DEFSUBR */
|
|
|
574 }
|
|
|
575
|
|
|
576 void
|
|
|
577 vars_of_tests (void)
|
|
|
578 {
|
|
|
579 DEFVAR_LISP ("test-function-list", &Vtest_function_list /*
|
|
|
580 List of all test functions defined in tests.c.
|
|
|
581 For use by the automated test suite. See tests/automated/c-tests.
|
|
|
582 */ );
|
|
|
583 }
|
