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