HCoop / bpt / guile.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
merge from 1.8 branch
[bpt/guile.git] / test-suite / standalone / test-conversion.c
1 /* Copyright (C) 1999,2000,2001,2003,2004, 2006 Free Software Foundation, Inc.
2 *
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
7 *
8 * This library is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
12 *
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
16 */
17
18 #include "libguile.h"
19
20 #include <stdio.h>
21 #include <assert.h>
22 #include <string.h>
23
24 static void
25 test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
26 int result)
27 {
28 int r = scm_is_signed_integer (scm_c_eval_string (str), min, max);
29 if (r != result)
30 {
31 fprintf (stderr, "fail: scm_is_signed_integer (%s, %Ld, %Ld) == %d\n",
32 str, min, max, result);
33 exit (1);
34 }
35 }
36
37 static void
38 test_is_signed_integer ()
39 {
40 test_1 ("'foo",
41 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
42 0);
43 test_1 ("3.0",
44 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
45 0);
46 test_1 ("(inexact->exact 3.0)",
47 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
48 1);
49 test_1 ("3.5",
50 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
51 0);
52 test_1 ("most-positive-fixnum",
53 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
54 1);
55 test_1 ("(+ most-positive-fixnum 1)",
56 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
57 1);
58 test_1 ("most-negative-fixnum",
59 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
60 1);
61 test_1 ("(- most-negative-fixnum 1)",
62 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
63 1);
64 if (sizeof (scm_t_intmax) == 8)
65 {
66 test_1 ("(- (expt 2 63) 1)",
67 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
68 1);
69 test_1 ("(expt 2 63)",
70 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
71 0);
72 test_1 ("(- (expt 2 63))",
73 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
74 1);
75 test_1 ("(- (- (expt 2 63)) 1)",
76 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
77 0);
78 }
79 else if (sizeof (scm_t_intmax) == 4)
80 {
81 test_1 ("(- (expt 2 31) 1)",
82 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
83 1);
84 test_1 ("(expt 2 31)",
85 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
86 0);
87 test_1 ("(- (expt 2 31))",
88 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
89 1);
90 test_1 ("(- (- (expt 2 31)) 1)",
91 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
92 0);
93 }
94 else
95 fprintf (stderr, "NOTE: skipped some tests.\n");
96
97 /* bignum with range that fits into fixnum. */
98 test_1 ("(+ most-positive-fixnum 1)",
99 -32768, 32767,
100 0);
101
102 /* bignum with range that doesn't fit into fixnum, but probably
103 fits into long. */
104 test_1 ("(+ most-positive-fixnum 1)",
105 SCM_MOST_NEGATIVE_FIXNUM-1, SCM_MOST_POSITIVE_FIXNUM+1,
106 1);
107 }
108
109 static void
110 test_2 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
111 int result)
112 {
113 int r = scm_is_unsigned_integer (scm_c_eval_string (str), min, max);
114 if (r != result)
115 {
116 fprintf (stderr, "fail: scm_is_unsigned_integer (%s, %Lu, %Lu) == %d\n",
117 str, min, max, result);
118 exit (1);
119 }
120 }
121
122 static void
123 test_is_unsigned_integer ()
124 {
125 test_2 ("'foo",
126 0, SCM_T_UINTMAX_MAX,
127 0);
128 test_2 ("3.0",
129 0, SCM_T_UINTMAX_MAX,
130 0);
131 test_2 ("(inexact->exact 3.0)",
132 0, SCM_T_UINTMAX_MAX,
133 1);
134 test_2 ("3.5",
135 0, SCM_T_UINTMAX_MAX,
136 0);
137 test_2 ("most-positive-fixnum",
138 0, SCM_T_UINTMAX_MAX,
139 1);
140 test_2 ("(+ most-positive-fixnum 1)",
141 0, SCM_T_UINTMAX_MAX,
142 1);
143 test_2 ("most-negative-fixnum",
144 0, SCM_T_UINTMAX_MAX,
145 0);
146 test_2 ("(- most-negative-fixnum 1)",
147 0, SCM_T_UINTMAX_MAX,
148 0);
149 if (sizeof (scm_t_intmax) == 8)
150 {
151 test_2 ("(- (expt 2 64) 1)",
152 0, SCM_T_UINTMAX_MAX,
153 1);
154 test_2 ("(expt 2 64)",
155 0, SCM_T_UINTMAX_MAX,
156 0);
157 }
158 else if (sizeof (scm_t_intmax) == 4)
159 {
160 test_2 ("(- (expt 2 32) 1)",
161 0, SCM_T_UINTMAX_MAX,
162 1);
163 test_2 ("(expt 2 32)",
164 0, SCM_T_UINTMAX_MAX,
165 0);
166 }
167 else
168 fprintf (stderr, "NOTE: skipped some tests.\n");
169
170 /* bignum with range that fits into fixnum. */
171 test_2 ("(+ most-positive-fixnum 1)",
172 0, 32767,
173 0);
174
175 /* bignum with range that doesn't fit into fixnum, but probably
176 fits into long. */
177 test_2 ("(+ most-positive-fixnum 1)",
178 0, SCM_MOST_POSITIVE_FIXNUM+1,
179 1);
180 }
181
182 typedef struct {
183 SCM val;
184 scm_t_intmax min, max;
185 scm_t_intmax result;
186 } to_signed_data;
187
188 static SCM
189 out_of_range_handler (void *data, SCM key, SCM args)
190 {
191 return scm_equal_p (key, scm_from_locale_symbol ("out-of-range"));
192 }
193
194 static SCM
195 wrong_type_handler (void *data, SCM key, SCM args)
196 {
197 return scm_equal_p (key, scm_from_locale_symbol ("wrong-type-arg"));
198 }
199
200 static SCM
201 misc_error_handler (void *data, SCM key, SCM args)
202 {
203 return scm_equal_p (key, scm_from_locale_symbol ("misc-error"));
204 }
205
206 static SCM
207 any_handler (void *data, SCM key, SCM args)
208 {
209 return SCM_BOOL_T;
210 }
211
212 static SCM
213 to_signed_integer_body (void *data)
214 {
215 to_signed_data *d = (to_signed_data *)data;
216 d->result = scm_to_signed_integer (d->val, d->min, d->max);
217 return SCM_BOOL_F;
218 }
219
220 static void
221 test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
222 scm_t_intmax result, int range_error, int type_error)
223 {
224 to_signed_data data;
225 data.val = scm_c_eval_string (str);
226 data.min = min;
227 data.max = max;
228
229 if (range_error)
230 {
231 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
232 to_signed_integer_body, &data,
233 out_of_range_handler, NULL)))
234 {
235 fprintf (stderr,
236 "fail: scm_to_signed_int (%s, %Ld, %Ld) -> out of range\n",
237 str, min, max);
238 exit (1);
239 }
240 }
241 else if (type_error)
242 {
243 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
244 to_signed_integer_body, &data,
245 wrong_type_handler, NULL)))
246 {
247 fprintf (stderr,
248 "fail: scm_to_signed_int (%s, %Ld, %Ld) -> wrong type\n",
249 str, min, max);
250 exit (1);
251 }
252 }
253 else
254 {
255 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
256 to_signed_integer_body, &data,
257 any_handler, NULL))
258 || data.result != result)
259 {
260 fprintf (stderr,
261 "fail: scm_to_signed_int (%s, %Ld, %Ld) = %Ld\n",
262 str, min, max, result);
263 exit (1);
264 }
265 }
266 }
267
268 static void
269 test_to_signed_integer ()
270 {
271 test_3 ("'foo",
272 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
273 0, 0, 1);
274 test_3 ("3.5",
275 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
276 0, 0, 1);
277 test_3 ("12",
278 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
279 12, 0, 0);
280 test_3 ("1000",
281 -999, 999,
282 0, 1, 0);
283 test_3 ("-1000",
284 -999, 999,
285 0, 1, 0);
286 test_3 ("most-positive-fixnum",
287 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
288 SCM_MOST_POSITIVE_FIXNUM, 0, 0);
289 test_3 ("most-negative-fixnum",
290 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
291 SCM_MOST_NEGATIVE_FIXNUM, 0, 0);
292 test_3 ("(+ most-positive-fixnum 1)",
293 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
294 SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
295 test_3 ("(- most-negative-fixnum 1)",
296 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
297 SCM_MOST_NEGATIVE_FIXNUM-1, 0, 0);
298 if (sizeof (scm_t_intmax) == 8)
299 {
300 test_3 ("(- (expt 2 63) 1)",
301 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
302 SCM_T_INTMAX_MAX, 0, 0);
303 test_3 ("(+ (- (expt 2 63)) 1)",
304 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
305 SCM_T_INTMAX_MIN+1, 0, 0);
306 test_3 ("(- (expt 2 63))",
307 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
308 SCM_T_INTMAX_MIN, 0, 0);
309 test_3 ("(expt 2 63)",
310 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
311 0, 1, 0);
312 test_3 ("(- (- (expt 2 63)) 1)",
313 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
314 0, 1, 0);
315 }
316 else if (sizeof (scm_t_intmax) == 4)
317 {
318 test_3 ("(- (expt 2 31) 1)",
319 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
320 SCM_T_INTMAX_MAX, 0, 0);
321 test_3 ("(+ (- (expt 2 31)) 1)",
322 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
323 SCM_T_INTMAX_MIN+1, 0, 0);
324 test_3 ("(- (expt 2 31))",
325 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
326 SCM_T_INTMAX_MIN, 0, 0);
327 test_3 ("(expt 2 31)",
328 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
329 0, 1, 0);
330 test_3 ("(- (- (expt 2 31)) 1)",
331 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
332 0, 1, 0);
333 }
334 else
335 fprintf (stderr, "NOTE: skipped some tests.\n");
336 }
337
338 typedef struct {
339 SCM val;
340 scm_t_uintmax min, max;
341 scm_t_uintmax result;
342 } to_unsigned_data;
343
344 static SCM
345 to_unsigned_integer_body (void *data)
346 {
347 to_unsigned_data *d = (to_unsigned_data *)data;
348 d->result = scm_to_unsigned_integer (d->val, d->min, d->max);
349 return SCM_BOOL_F;
350 }
351
352 static void
353 test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
354 scm_t_uintmax result, int range_error, int type_error)
355 {
356 to_unsigned_data data;
357 data.val = scm_c_eval_string (str);
358 data.min = min;
359 data.max = max;
360
361 if (range_error)
362 {
363 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
364 to_unsigned_integer_body, &data,
365 out_of_range_handler, NULL)))
366 {
367 fprintf (stderr,
368 "fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> out of range\n",
369 str, min, max);
370 exit (1);
371 }
372 }
373 else if (type_error)
374 {
375 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
376 to_unsigned_integer_body, &data,
377 wrong_type_handler, NULL)))
378 {
379 fprintf (stderr,
380 "fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> wrong type\n",
381 str, min, max);
382 exit (1);
383 }
384 }
385 else
386 {
387 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
388 to_unsigned_integer_body, &data,
389 any_handler, NULL))
390 || data.result != result)
391 {
392 fprintf (stderr,
393 "fail: scm_to_unsigned_int (%s, %Lu, %Lu) == %Lu\n",
394 str, min, max, result);
395 exit (1);
396 }
397 }
398 }
399
400 static void
401 test_to_unsigned_integer ()
402 {
403 test_4 ("'foo",
404 0, SCM_T_UINTMAX_MAX,
405 0, 0, 1);
406 test_4 ("3.5",
407 0, SCM_T_UINTMAX_MAX,
408 0, 0, 1);
409 test_4 ("12",
410 0, SCM_T_UINTMAX_MAX,
411 12, 0, 0);
412 test_4 ("1000",
413 0, 999,
414 0, 1, 0);
415 test_4 ("most-positive-fixnum",
416 0, SCM_T_UINTMAX_MAX,
417 SCM_MOST_POSITIVE_FIXNUM, 0, 0);
418 test_4 ("(+ most-positive-fixnum 1)",
419 0, SCM_T_UINTMAX_MAX,
420 SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
421 if (sizeof (scm_t_intmax) == 8)
422 {
423 test_4 ("(- (expt 2 64) 1)",
424 0, SCM_T_UINTMAX_MAX,
425 SCM_T_UINTMAX_MAX, 0, 0);
426 test_4 ("(expt 2 64)",
427 0, SCM_T_UINTMAX_MAX,
428 0, 1, 0);
429 }
430 else if (sizeof (scm_t_intmax) == 4)
431 {
432 test_4 ("(- (expt 2 32) 1)",
433 0, SCM_T_UINTMAX_MAX,
434 SCM_T_UINTMAX_MAX, 0, 0);
435 test_4 ("(expt 2 32)",
436 0, SCM_T_UINTMAX_MAX,
437 0, 1, 0);
438 }
439 else
440 fprintf (stderr, "NOTE: skipped some tests.\n");
441 }
442
443 static void
444 test_5 (scm_t_intmax val, const char *result)
445 {
446 SCM res = scm_c_eval_string (result);
447 if (scm_is_false (scm_equal_p (scm_from_signed_integer (val), res)))
448 {
449 fprintf (stderr, "fail: scm_from_signed_integer (%Ld) == %s\n",
450 val, result);
451 exit (1);
452 }
453 }
454
455 static void
456 test_from_signed_integer ()
457 {
458 test_5 (12, "12");
459 if (sizeof (scm_t_intmax) == 8)
460 {
461 test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 63) 1)");
462 test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 63))");
463 }
464 else if (sizeof (scm_t_intmax) == 4)
465 {
466 test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 31) 1)");
467 test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 31))");
468 }
469 test_5 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
470 test_5 (SCM_MOST_NEGATIVE_FIXNUM, "most-negative-fixnum");
471 test_5 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
472 test_5 (SCM_MOST_NEGATIVE_FIXNUM-1, "(- most-negative-fixnum 1)");
473 }
474
475 static void
476 test_6 (scm_t_uintmax val, const char *result)
477 {
478 SCM res = scm_c_eval_string (result);
479 if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res)))
480 {
481 fprintf (stderr, "fail: scm_from_unsigned_integer (%Lu) == %s\n",
482 val, result);
483 exit (1);
484 }
485 }
486
487 static void
488 test_from_unsigned_integer ()
489 {
490 test_6 (12, "12");
491 if (sizeof (scm_t_intmax) == 8)
492 {
493 test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 64) 1)");
494 }
495 else if (sizeof (scm_t_intmax) == 4)
496 {
497 test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 32) 1)");
498 }
499 test_6 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
500 test_6 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
501 }
502
503 static void
504 test_7s (SCM n, scm_t_intmax c_n, const char *result, const char *func)
505 {
506 SCM r = scm_c_eval_string (result);
507
508 if (scm_is_false (scm_equal_p (n, r)))
509 {
510 fprintf (stderr, "fail: %s (%Ld) == %s\n", func, c_n, result);
511 exit (1);
512 }
513 }
514
515 #define TEST_7S(func,arg,res) test_7s (func(arg), arg, res, #func)
516
517 static void
518 test_7u (SCM n, scm_t_uintmax c_n, const char *result, const char *func)
519 {
520 SCM r = scm_c_eval_string (result);
521
522 if (scm_is_false (scm_equal_p (n, r)))
523 {
524 fprintf (stderr, "fail: %s (%Lu) == %s\n", func, c_n, result);
525 exit (1);
526 }
527 }
528
529 #define TEST_7U(func,arg,res) test_7u (func(arg), arg, res, #func)
530
531 typedef struct {
532 SCM val;
533 scm_t_intmax (*func) (SCM);
534 scm_t_intmax result;
535 } to_signed_func_data;
536
537 static SCM
538 to_signed_func_body (void *data)
539 {
540 to_signed_func_data *d = (to_signed_func_data *)data;
541 d->result = d->func (d->val);
542 return SCM_BOOL_F;
543 }
544
545 static void
546 test_8s (const char *str, scm_t_intmax (*func) (SCM), const char *func_name,
547 scm_t_intmax result, int range_error, int type_error)
548 {
549 to_signed_func_data data;
550 data.val = scm_c_eval_string (str);
551 data.func = func;
552
553 if (range_error)
554 {
555 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
556 to_signed_func_body, &data,
557 out_of_range_handler, NULL)))
558 {
559 fprintf (stderr,
560 "fail: %s (%s) -> out of range\n", func_name, str);
561 exit (1);
562 }
563 }
564 else if (type_error)
565 {
566 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
567 to_signed_func_body, &data,
568 wrong_type_handler, NULL)))
569 {
570 fprintf (stderr,
571 "fail: %s (%s) -> wrong type\n", func_name, str);
572 exit (1);
573 }
574 }
575 else
576 {
577 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
578 to_signed_func_body, &data,
579 any_handler, NULL))
580 || data.result != result)
581 {
582 fprintf (stderr,
583 "fail: %s (%s) = %Ld\n", func_name, str, result);
584 exit (1);
585 }
586 }
587 }
588
589 typedef struct {
590 SCM val;
591 scm_t_uintmax (*func) (SCM);
592 scm_t_uintmax result;
593 } to_unsigned_func_data;
594
595 static SCM
596 to_unsigned_func_body (void *data)
597 {
598 to_unsigned_func_data *d = (to_unsigned_func_data *)data;
599 d->result = d->func (d->val);
600 return SCM_BOOL_F;
601 }
602
603 static void
604 test_8u (const char *str, scm_t_uintmax (*func) (SCM), const char *func_name,
605 scm_t_uintmax result, int range_error, int type_error)
606 {
607 to_unsigned_func_data data;
608 data.val = scm_c_eval_string (str);
609 data.func = func;
610
611 if (range_error)
612 {
613 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
614 to_unsigned_func_body, &data,
615 out_of_range_handler, NULL)))
616 {
617 fprintf (stderr,
618 "fail: %s (%s) -> out of range\n", func_name, str);
619 exit (1);
620 }
621 }
622 else if (type_error)
623 {
624 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
625 to_unsigned_func_body, &data,
626 wrong_type_handler, NULL)))
627 {
628 fprintf (stderr,
629 "fail: %s (%s) -> wrong type\n", func_name, str);
630 exit (1);
631 }
632 }
633 else
634 {
635 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
636 to_unsigned_func_body, &data,
637 any_handler, NULL))
638 || data.result != result)
639 {
640 fprintf (stderr,
641 "fail: %s (%s) = %Ld\n", func_name, str, result);
642 exit (1);
643 }
644 }
645 }
646
647 /* We can't rely on the scm_to functions being proper functions but we
648 want to pass them to test_8s and test_8u, so we wrap'em. Also, we
649 need to give them a common return type.
650 */
651
652 #define DEFSTST(f) static scm_t_intmax tst_##f (SCM x) { return f(x); }
653 #define DEFUTST(f) static scm_t_uintmax tst_##f (SCM x) { return f(x); }
654
655 DEFSTST (scm_to_schar);
656 DEFUTST (scm_to_uchar);
657 DEFSTST (scm_to_char);
658 DEFSTST (scm_to_short);
659 DEFUTST (scm_to_ushort);
660 DEFSTST (scm_to_int);
661 DEFUTST (scm_to_uint);
662 DEFSTST (scm_to_long);
663 DEFUTST (scm_to_ulong);
664 #if SCM_SIZEOF_LONG_LONG != 0
665 DEFSTST (scm_to_long_long);
666 DEFUTST (scm_to_ulong_long);
667 #endif
668 DEFSTST (scm_to_ssize_t);
669 DEFUTST (scm_to_size_t);
670
671 DEFSTST (scm_to_int8);
672 DEFUTST (scm_to_uint8);
673 DEFSTST (scm_to_int16);
674 DEFUTST (scm_to_uint16);
675 DEFSTST (scm_to_int32);
676 DEFUTST (scm_to_uint32);
677 #ifdef SCM_HAVE_T_INT64
678 DEFSTST (scm_to_int64);
679 DEFUTST (scm_to_uint64);
680 #endif
681
682 #define TEST_8S(v,f,r,re,te) test_8s (v, tst_##f, #f, r, re, te)
683 #define TEST_8U(v,f,r,re,te) test_8u (v, tst_##f, #f, r, re, te)
684
685
686 static void
687 test_int_sizes ()
688 {
689 TEST_7U (scm_from_uchar, 91, "91");
690 TEST_7S (scm_from_schar, 91, "91");
691 TEST_7S (scm_from_char, 91, "91");
692 TEST_7S (scm_from_short, -911, "-911");
693 TEST_7U (scm_from_ushort, 911, "911");
694 TEST_7S (scm_from_int, 911, "911");
695 TEST_7U (scm_from_uint, 911, "911");
696 TEST_7S (scm_from_long, 911, "911");
697 TEST_7U (scm_from_ulong, 911, "911");
698 #if SCM_SIZEOF_LONG_LONG != 0
699 TEST_7S (scm_from_long_long, 911, "911");
700 TEST_7U (scm_from_ulong_long, 911, "911");
701 #endif
702 TEST_7U (scm_from_size_t, 911, "911");
703 TEST_7S (scm_from_ssize_t, 911, "911");
704
705 TEST_7S (scm_from_int8, -128, "-128");
706 TEST_7S (scm_from_int8, 127, "127");
707 TEST_7S (scm_from_int8, 128, "-128");
708 TEST_7U (scm_from_uint8, 255, "255");
709
710 TEST_7S (scm_from_int16, -32768, "-32768");
711 TEST_7S (scm_from_int16, 32767, "32767");
712 TEST_7S (scm_from_int16, 32768, "-32768");
713 TEST_7U (scm_from_uint16, 65535, "65535");
714
715 TEST_7S (scm_from_int32, SCM_T_INT32_MIN, "-2147483648");
716 TEST_7S (scm_from_int32, SCM_T_INT32_MAX, "2147483647");
717 TEST_7S (scm_from_int32, SCM_T_INT32_MAX+1LL, "-2147483648");
718 TEST_7U (scm_from_uint32, SCM_T_UINT32_MAX, "4294967295");
719
720 #if SCM_HAVE_T_INT64
721 TEST_7S (scm_from_int64, SCM_T_INT64_MIN, "-9223372036854775808");
722 TEST_7S (scm_from_int64, SCM_T_INT64_MAX, "9223372036854775807");
723 TEST_7U (scm_from_uint64, SCM_T_UINT64_MAX, "18446744073709551615");
724 #endif
725
726 TEST_8S ("91", scm_to_schar, 91, 0, 0);
727 TEST_8U ("91", scm_to_uchar, 91, 0, 0);
728 TEST_8S ("91", scm_to_char, 91, 0, 0);
729 TEST_8S ("-911", scm_to_short, -911, 0, 0);
730 TEST_8U ("911", scm_to_ushort, 911, 0, 0);
731 TEST_8S ("-911", scm_to_int, -911, 0, 0);
732 TEST_8U ("911", scm_to_uint, 911, 0, 0);
733 TEST_8S ("-911", scm_to_long, -911, 0, 0);
734 TEST_8U ("911", scm_to_ulong, 911, 0, 0);
735 #if SCM_SIZEOF_LONG_LONG != 0
736 TEST_8S ("-911", scm_to_long_long, -911, 0, 0);
737 TEST_8U ("911", scm_to_ulong_long, 911, 0, 0);
738 #endif
739 TEST_8U ("911", scm_to_size_t, 911, 0, 0);
740 TEST_8S ("911", scm_to_ssize_t, 911, 0, 0);
741
742 TEST_8S ("-128", scm_to_int8, SCM_T_INT8_MIN, 0, 0);
743 TEST_8S ("127", scm_to_int8, SCM_T_INT8_MAX, 0, 0);
744 TEST_8S ("128", scm_to_int8, 0, 1, 0);
745 TEST_8S ("#f", scm_to_int8, 0, 0, 1);
746 TEST_8U ("255", scm_to_uint8, SCM_T_UINT8_MAX, 0, 0);
747 TEST_8U ("256", scm_to_uint8, 0, 1, 0);
748 TEST_8U ("-1", scm_to_uint8, 0, 1, 0);
749 TEST_8U ("#f", scm_to_uint8, 0, 0, 1);
750
751 TEST_8S ("-32768", scm_to_int16, SCM_T_INT16_MIN, 0, 0);
752 TEST_8S ("32767", scm_to_int16, SCM_T_INT16_MAX, 0, 0);
753 TEST_8S ("32768", scm_to_int16, 0, 1, 0);
754 TEST_8S ("#f", scm_to_int16, 0, 0, 1);
755 TEST_8U ("65535", scm_to_uint16, SCM_T_UINT16_MAX, 0, 0);
756 TEST_8U ("65536", scm_to_uint16, 0, 1, 0);
757 TEST_8U ("-1", scm_to_uint16, 0, 1, 0);
758 TEST_8U ("#f", scm_to_uint16, 0, 0, 1);
759
760 TEST_8S ("-2147483648", scm_to_int32, SCM_T_INT32_MIN, 0, 0);
761 TEST_8S ("2147483647", scm_to_int32, SCM_T_INT32_MAX, 0, 0);
762 TEST_8S ("2147483648", scm_to_int32, 0, 1, 0);
763 TEST_8S ("#f", scm_to_int32, 0, 0, 1);
764 TEST_8U ("4294967295", scm_to_uint32, SCM_T_UINT32_MAX, 0, 0);
765 TEST_8U ("4294967296", scm_to_uint32, 0, 1, 0);
766 TEST_8U ("-1", scm_to_uint32, 0, 1, 0);
767 TEST_8U ("#f", scm_to_uint32, 0, 0, 1);
768
769 #if SCM_HAVE_T_INT64
770 TEST_8S ("-9223372036854775808", scm_to_int64, SCM_T_INT64_MIN, 0, 0);
771 TEST_8S ("9223372036854775807", scm_to_int64, SCM_T_INT64_MAX, 0, 0);
772 TEST_8S ("9223372036854775808", scm_to_int64, 0, 1, 0);
773 TEST_8S ("#f", scm_to_int64, 0, 0, 1);
774 TEST_8U ("18446744073709551615", scm_to_uint64, SCM_T_UINT64_MAX, 0, 0);
775 TEST_8U ("18446744073709551616", scm_to_uint64, 0, 1, 0);
776 TEST_8U ("-1", scm_to_uint64, 0, 1, 0);
777 TEST_8U ("#f", scm_to_uint64, 0, 0, 1);
778 #endif
779
780 }
781
782 static void
783 test_9 (double val, const char *result)
784 {
785 SCM res = scm_c_eval_string (result);
786 if (scm_is_false (scm_eqv_p (res, scm_from_double (val))))
787 {
788 fprintf (stderr, "fail: scm_from_double (%g) == %s\n", val, result);
789 exit (1);
790 }
791 }
792
793 static void
794 test_from_double ()
795 {
796 test_9 (12, "12.0");
797 test_9 (0.25, "0.25");
798 test_9 (0.1, "0.1");
799 test_9 (1.0/0.0, "+inf.0");
800 test_9 (-1.0/0.0, "-inf.0");
801 test_9 (0.0/0.0, "+nan.0");
802 }
803
804 typedef struct {
805 SCM val;
806 double result;
807 } to_double_data;
808
809 static SCM
810 to_double_body (void *data)
811 {
812 to_double_data *d = (to_double_data *)data;
813 d->result = scm_to_double (d->val);
814 return SCM_BOOL_F;
815 }
816
817 static void
818 test_10 (const char *val, double result, int type_error)
819 {
820 to_double_data data;
821 data.val = scm_c_eval_string (val);
822
823 if (type_error)
824 {
825 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
826 to_double_body, &data,
827 wrong_type_handler, NULL)))
828 {
829 fprintf (stderr,
830 "fail: scm_double (%s) -> wrong type\n", val);
831 exit (1);
832 }
833 }
834 else
835 {
836 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
837 to_double_body, &data,
838 any_handler, NULL))
839 || data.result != result)
840 {
841 fprintf (stderr,
842 "fail: scm_to_double (%s) = %g\n", val, result);
843 exit (1);
844 }
845 }
846 }
847
848 static void
849 test_to_double ()
850 {
851 test_10 ("#f", 0.0, 1);
852 test_10 ("12", 12.0, 0);
853 test_10 ("0.25", 0.25, 0);
854 test_10 ("1/4", 0.25, 0);
855 test_10 ("+inf.0", 1.0/0.0, 0);
856 test_10 ("-inf.0", -1.0/0.0, 0);
857 test_10 ("+1i", 0.0, 1);
858 }
859
860 typedef struct {
861 SCM val;
862 char *result;
863 } to_locale_string_data;
864
865 static SCM
866 to_locale_string_body (void *data)
867 {
868 to_locale_string_data *d = (to_locale_string_data *)data;
869 d->result = scm_to_locale_string (d->val);
870 return SCM_BOOL_F;
871 }
872
873 static void
874 test_11 (const char *str, const char *result, int misc_error, int type_error)
875 {
876 to_locale_string_data data;
877 data.val = scm_c_eval_string (str);
878 data.result = NULL;
879
880 if (misc_error)
881 {
882 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
883 to_locale_string_body, &data,
884 misc_error_handler, NULL)))
885 {
886 fprintf (stderr,
887 "fail: scm_to_locale_string (%s) -> misc error\n", str);
888 exit (1);
889 }
890 }
891 else if (type_error)
892 {
893 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
894 to_locale_string_body, &data,
895 wrong_type_handler, NULL)))
896 {
897 fprintf (stderr,
898 "fail: scm_to_locale_string (%s) -> wrong type\n", str);
899 exit (1);
900 }
901 }
902 else
903 {
904 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
905 to_locale_string_body, &data,
906 any_handler, NULL))
907 || data.result == NULL || strcmp (data.result, result))
908 {
909 fprintf (stderr,
910 "fail: scm_to_locale_string (%s) = %s\n", str, result);
911 exit (1);
912 }
913 }
914
915 free (data.result);
916 }
917
918 static void
919 test_locale_strings ()
920 {
921 const char *lstr = "This is not a string.";
922 char *lstr2;
923 SCM str, str2;
924 char buf[20];
925 size_t len;
926
927 if (!scm_is_string (scm_c_eval_string ("\"foo\"")))
928 {
929 fprintf (stderr, "fail: scm_is_string (\"foo\") = true\n");
930 exit (1);
931 }
932
933 str = scm_from_locale_string (lstr);
934
935 if (!scm_is_string (str))
936 {
937 fprintf (stderr, "fail: scm_is_string (str) = true\n");
938 exit (1);
939 }
940
941 lstr2 = scm_to_locale_string (str);
942 if (strcmp (lstr, lstr2))
943 {
944 fprintf (stderr, "fail: lstr = lstr2\n");
945 exit (1);
946 }
947 free (lstr2);
948
949 buf[15] = 'x';
950 len = scm_to_locale_stringbuf (str, buf, 15);
951 if (len != strlen (lstr))
952 {
953 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) = strlen(lstr)\n");
954 exit (1);
955 }
956 if (buf[15] != 'x')
957 {
958 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) no overrun\n");
959 exit (1);
960 }
961 if (strncmp (lstr, buf, 15))
962 {
963 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) = lstr\n");
964 exit (1);
965 }
966
967 str2 = scm_from_locale_stringn (lstr, 10);
968
969 if (!scm_is_string (str2))
970 {
971 fprintf (stderr, "fail: scm_is_string (str2) = true\n");
972 exit (1);
973 }
974
975 lstr2 = scm_to_locale_string (str2);
976 if (strncmp (lstr, lstr2, 10))
977 {
978 fprintf (stderr, "fail: lstr = lstr2\n");
979 exit (1);
980 }
981 free (lstr2);
982
983 buf[10] = 'x';
984 len = scm_to_locale_stringbuf (str2, buf, 20);
985 if (len != 10)
986 {
987 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) = 10\n");
988 exit (1);
989 }
990 if (buf[10] != 'x')
991 {
992 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) no overrun\n");
993 exit (1);
994 }
995 if (strncmp (lstr, buf, 10))
996 {
997 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) = lstr\n");
998 exit (1);
999 }
1000
1001 lstr2 = scm_to_locale_stringn (str2, &len);
1002 if (len != 10)
1003 {
1004 fprintf (stderr, "fail: scm_to_locale_stringn, len = 10\n");
1005 exit (1);
1006 }
1007
1008 test_11 ("#f", NULL, 0, 1);
1009 test_11 ("\"foo\"", "foo", 0, 0);
1010 test_11 ("(string #\\f #\\nul)", NULL, 1, 0);
1011 }
1012
1013 static void
1014 tests (void *data, int argc, char **argv)
1015 {
1016 test_is_signed_integer ();
1017 test_is_unsigned_integer ();
1018 test_to_signed_integer ();
1019 test_to_unsigned_integer ();
1020 test_from_signed_integer ();
1021 test_from_unsigned_integer ();
1022 test_int_sizes ();
1023 test_from_double ();
1024 test_to_double ();
1025 test_locale_strings ();
1026 }
1027
1028 int
1029 main (int argc, char *argv[])
1030 {
1031 scm_boot_guile (argc, argv, tests, NULL);
1032 return 0;
1033 }
Unnamed repository; edit this file 'description' to name the repository.