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