1 /* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
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.
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.
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
28 #ifdef HAVE_INTTYPES_H
29 # include <inttypes.h>
33 # if (defined SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG >= 8)
34 # define PRIiMAX "lli"
35 # define PRIuMAX "llu"
44 test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
47 int r = scm_is_signed_integer (scm_c_eval_string (str), min, max);
50 fprintf (stderr, "fail: scm_is_signed_integer (%s, "
51 "%" PRIiMAX ", %" PRIiMAX ") == %d\n",
52 str, min, max, result);
58 test_is_signed_integer ()
61 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
64 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
66 test_1 ("(inexact->exact 3.0)",
67 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
70 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
72 test_1 ("most-positive-fixnum",
73 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
75 test_1 ("(+ most-positive-fixnum 1)",
76 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
78 test_1 ("most-negative-fixnum",
79 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
81 test_1 ("(- most-negative-fixnum 1)",
82 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
84 if (sizeof (scm_t_intmax) == 8)
86 test_1 ("(- (expt 2 63) 1)",
87 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
89 test_1 ("(expt 2 63)",
90 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
92 test_1 ("(- (expt 2 63))",
93 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
95 test_1 ("(- (- (expt 2 63)) 1)",
96 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
99 else if (sizeof (scm_t_intmax) == 4)
101 test_1 ("(- (expt 2 31) 1)",
102 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
104 test_1 ("(expt 2 31)",
105 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
107 test_1 ("(- (expt 2 31))",
108 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
110 test_1 ("(- (- (expt 2 31)) 1)",
111 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
115 fprintf (stderr, "NOTE: skipped some tests.\n");
117 /* bignum with range that fits into fixnum. */
118 test_1 ("(+ most-positive-fixnum 1)",
122 /* bignum with range that doesn't fit into fixnum, but probably
124 test_1 ("(+ most-positive-fixnum 1)",
125 SCM_MOST_NEGATIVE_FIXNUM-1, SCM_MOST_POSITIVE_FIXNUM+1,
130 test_2 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
133 int r = scm_is_unsigned_integer (scm_c_eval_string (str), min, max);
136 fprintf (stderr, "fail: scm_is_unsigned_integer (%s, "
137 "%" PRIuMAX ", %" PRIuMAX ") == %d\n",
138 str, min, max, result);
144 test_is_unsigned_integer ()
147 0, SCM_T_UINTMAX_MAX,
150 0, SCM_T_UINTMAX_MAX,
152 test_2 ("(inexact->exact 3.0)",
153 0, SCM_T_UINTMAX_MAX,
156 0, SCM_T_UINTMAX_MAX,
158 test_2 ("most-positive-fixnum",
159 0, SCM_T_UINTMAX_MAX,
161 test_2 ("(+ most-positive-fixnum 1)",
162 0, SCM_T_UINTMAX_MAX,
164 test_2 ("most-negative-fixnum",
165 0, SCM_T_UINTMAX_MAX,
167 test_2 ("(- most-negative-fixnum 1)",
168 0, SCM_T_UINTMAX_MAX,
170 if (sizeof (scm_t_intmax) == 8)
172 test_2 ("(- (expt 2 64) 1)",
173 0, SCM_T_UINTMAX_MAX,
175 test_2 ("(expt 2 64)",
176 0, SCM_T_UINTMAX_MAX,
179 else if (sizeof (scm_t_intmax) == 4)
181 test_2 ("(- (expt 2 32) 1)",
182 0, SCM_T_UINTMAX_MAX,
184 test_2 ("(expt 2 32)",
185 0, SCM_T_UINTMAX_MAX,
189 fprintf (stderr, "NOTE: skipped some tests.\n");
191 /* bignum with range that fits into fixnum. */
192 test_2 ("(+ most-positive-fixnum 1)",
196 /* bignum with range that doesn't fit into fixnum, but probably
198 test_2 ("(+ most-positive-fixnum 1)",
199 0, SCM_MOST_POSITIVE_FIXNUM+1,
205 scm_t_intmax min, max;
210 out_of_range_handler (void *data, SCM key, SCM args)
212 return scm_equal_p (key, scm_from_locale_symbol ("out-of-range"));
216 wrong_type_handler (void *data, SCM key, SCM args)
218 return scm_equal_p (key, scm_from_locale_symbol ("wrong-type-arg"));
222 misc_error_handler (void *data, SCM key, SCM args)
224 return scm_equal_p (key, scm_from_locale_symbol ("misc-error"));
228 any_handler (void *data, SCM key, SCM args)
234 to_signed_integer_body (void *data)
236 to_signed_data *d = (to_signed_data *)data;
237 d->result = scm_to_signed_integer (d->val, d->min, d->max);
242 test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
243 scm_t_intmax result, int range_error, int type_error)
246 data.val = scm_c_eval_string (str);
252 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
253 to_signed_integer_body, &data,
254 out_of_range_handler, NULL)))
257 "fail: scm_to_signed_int (%s, "
258 "%" PRIiMAX ", %" PRIiMAX ") -> out of range\n",
265 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
266 to_signed_integer_body, &data,
267 wrong_type_handler, NULL)))
270 "fail: scm_to_signed_int (%s, "
271 "%" PRIiMAX", %" PRIiMAX ") -> wrong type\n",
278 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
279 to_signed_integer_body, &data,
281 || data.result != result)
284 "fail: scm_to_signed_int (%s, "
285 "%" PRIiMAX ", %" PRIiMAX ") = %" PRIiMAX "\n",
286 str, min, max, result);
293 test_to_signed_integer ()
296 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
299 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
302 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
310 test_3 ("most-positive-fixnum",
311 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
312 SCM_MOST_POSITIVE_FIXNUM, 0, 0);
313 test_3 ("most-negative-fixnum",
314 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
315 SCM_MOST_NEGATIVE_FIXNUM, 0, 0);
316 test_3 ("(+ most-positive-fixnum 1)",
317 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
318 SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
319 test_3 ("(- most-negative-fixnum 1)",
320 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
321 SCM_MOST_NEGATIVE_FIXNUM-1, 0, 0);
322 if (sizeof (scm_t_intmax) == 8)
324 test_3 ("(- (expt 2 63) 1)",
325 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
326 SCM_T_INTMAX_MAX, 0, 0);
327 test_3 ("(+ (- (expt 2 63)) 1)",
328 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
329 SCM_T_INTMAX_MIN+1, 0, 0);
330 test_3 ("(- (expt 2 63))",
331 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
332 SCM_T_INTMAX_MIN, 0, 0);
333 test_3 ("(expt 2 63)",
334 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
336 test_3 ("(- (- (expt 2 63)) 1)",
337 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
340 else if (sizeof (scm_t_intmax) == 4)
342 test_3 ("(- (expt 2 31) 1)",
343 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
344 SCM_T_INTMAX_MAX, 0, 0);
345 test_3 ("(+ (- (expt 2 31)) 1)",
346 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
347 SCM_T_INTMAX_MIN+1, 0, 0);
348 test_3 ("(- (expt 2 31))",
349 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
350 SCM_T_INTMAX_MIN, 0, 0);
351 test_3 ("(expt 2 31)",
352 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
354 test_3 ("(- (- (expt 2 31)) 1)",
355 SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
359 fprintf (stderr, "NOTE: skipped some tests.\n");
364 scm_t_uintmax min, max;
365 scm_t_uintmax result;
369 to_unsigned_integer_body (void *data)
371 to_unsigned_data *d = (to_unsigned_data *)data;
372 d->result = scm_to_unsigned_integer (d->val, d->min, d->max);
377 test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
378 scm_t_uintmax result, int range_error, int type_error)
380 to_unsigned_data data;
381 data.val = scm_c_eval_string (str);
387 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
388 to_unsigned_integer_body, &data,
389 out_of_range_handler, NULL)))
392 "fail: scm_to_unsigned_int (%s, "
393 "%" PRIuMAX ", %" PRIuMAX ") -> out of range\n",
400 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
401 to_unsigned_integer_body, &data,
402 wrong_type_handler, NULL)))
405 "fail: scm_to_unsigned_int (%s, "
406 "%" PRIuMAX ", %" PRIuMAX ") -> wrong type\n",
413 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
414 to_unsigned_integer_body, &data,
416 || data.result != result)
419 "fail: scm_to_unsigned_int (%s, "
420 "%" PRIuMAX ", %" PRIuMAX ") == %" PRIuMAX "\n",
421 str, min, max, result);
428 test_to_unsigned_integer ()
431 0, SCM_T_UINTMAX_MAX,
434 0, SCM_T_UINTMAX_MAX,
437 0, SCM_T_UINTMAX_MAX,
442 test_4 ("most-positive-fixnum",
443 0, SCM_T_UINTMAX_MAX,
444 SCM_MOST_POSITIVE_FIXNUM, 0, 0);
445 test_4 ("(+ most-positive-fixnum 1)",
446 0, SCM_T_UINTMAX_MAX,
447 SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
448 if (sizeof (scm_t_intmax) == 8)
450 test_4 ("(- (expt 2 64) 1)",
451 0, SCM_T_UINTMAX_MAX,
452 SCM_T_UINTMAX_MAX, 0, 0);
453 test_4 ("(expt 2 64)",
454 0, SCM_T_UINTMAX_MAX,
457 else if (sizeof (scm_t_intmax) == 4)
459 test_4 ("(- (expt 2 32) 1)",
460 0, SCM_T_UINTMAX_MAX,
461 SCM_T_UINTMAX_MAX, 0, 0);
462 test_4 ("(expt 2 32)",
463 0, SCM_T_UINTMAX_MAX,
467 fprintf (stderr, "NOTE: skipped some tests.\n");
471 test_5 (scm_t_intmax val, const char *result)
473 SCM res = scm_c_eval_string (result);
474 if (scm_is_false (scm_equal_p (scm_from_signed_integer (val), res)))
476 fprintf (stderr, "fail: scm_from_signed_integer (%" PRIiMAX ") == %s\n",
483 test_from_signed_integer ()
486 if (sizeof (scm_t_intmax) == 8)
488 test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 63) 1)");
489 test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 63))");
491 else if (sizeof (scm_t_intmax) == 4)
493 test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 31) 1)");
494 test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 31))");
496 test_5 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
497 test_5 (SCM_MOST_NEGATIVE_FIXNUM, "most-negative-fixnum");
498 test_5 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
499 test_5 (SCM_MOST_NEGATIVE_FIXNUM-1, "(- most-negative-fixnum 1)");
503 test_6 (scm_t_uintmax val, const char *result)
505 SCM res = scm_c_eval_string (result);
506 if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res)))
508 fprintf (stderr, "fail: scm_from_unsigned_integer (%"
516 test_from_unsigned_integer ()
519 if (sizeof (scm_t_intmax) == 8)
521 test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 64) 1)");
523 else if (sizeof (scm_t_intmax) == 4)
525 test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 32) 1)");
527 test_6 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
528 test_6 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
532 test_7s (SCM n, scm_t_intmax c_n, const char *result, const char *func)
534 SCM r = scm_c_eval_string (result);
536 if (scm_is_false (scm_equal_p (n, r)))
538 fprintf (stderr, "fail: %s (%" PRIiMAX ") == %s\n", func, c_n, result);
543 #define TEST_7S(func,arg,res) test_7s (func(arg), arg, res, #func)
546 test_7u (SCM n, scm_t_uintmax c_n, const char *result, const char *func)
548 SCM r = scm_c_eval_string (result);
550 if (scm_is_false (scm_equal_p (n, r)))
552 fprintf (stderr, "fail: %s (%" PRIuMAX ") == %s\n", func, c_n, result);
557 #define TEST_7U(func,arg,res) test_7u (func(arg), arg, res, #func)
561 scm_t_intmax (*func) (SCM);
563 } to_signed_func_data;
566 to_signed_func_body (void *data)
568 to_signed_func_data *d = (to_signed_func_data *)data;
569 d->result = d->func (d->val);
574 test_8s (const char *str, scm_t_intmax (*func) (SCM), const char *func_name,
575 scm_t_intmax result, int range_error, int type_error)
577 to_signed_func_data data;
578 data.val = scm_c_eval_string (str);
583 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
584 to_signed_func_body, &data,
585 out_of_range_handler, NULL)))
588 "fail: %s (%s) -> out of range\n", func_name, str);
594 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
595 to_signed_func_body, &data,
596 wrong_type_handler, NULL)))
599 "fail: %s (%s) -> wrong type\n", func_name, str);
605 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
606 to_signed_func_body, &data,
608 || data.result != result)
611 "fail: %s (%s) = %" PRIiMAX "\n", func_name, str, result);
619 scm_t_uintmax (*func) (SCM);
620 scm_t_uintmax result;
621 } to_unsigned_func_data;
624 to_unsigned_func_body (void *data)
626 to_unsigned_func_data *d = (to_unsigned_func_data *)data;
627 d->result = d->func (d->val);
632 test_8u (const char *str, scm_t_uintmax (*func) (SCM), const char *func_name,
633 scm_t_uintmax result, int range_error, int type_error)
635 to_unsigned_func_data data;
636 data.val = scm_c_eval_string (str);
641 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
642 to_unsigned_func_body, &data,
643 out_of_range_handler, NULL)))
646 "fail: %s (%s) -> out of range\n", func_name, str);
652 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
653 to_unsigned_func_body, &data,
654 wrong_type_handler, NULL)))
657 "fail: %s (%s) -> wrong type\n", func_name, str);
663 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
664 to_unsigned_func_body, &data,
666 || data.result != result)
669 "fail: %s (%s) = %" PRIiMAX "\n", func_name, str, result);
675 /* We can't rely on the scm_to functions being proper functions but we
676 want to pass them to test_8s and test_8u, so we wrap'em. Also, we
677 need to give them a common return type.
680 #define DEFSTST(f) static scm_t_intmax tst_##f (SCM x) { return f(x); }
681 #define DEFUTST(f) static scm_t_uintmax tst_##f (SCM x) { return f(x); }
683 DEFSTST (scm_to_schar)
684 DEFUTST (scm_to_uchar)
685 DEFSTST (scm_to_char)
686 DEFSTST (scm_to_short)
687 DEFUTST (scm_to_ushort)
689 DEFUTST (scm_to_uint)
690 DEFSTST (scm_to_long)
691 DEFUTST (scm_to_ulong)
692 #if SCM_SIZEOF_LONG_LONG != 0
693 DEFSTST (scm_to_long_long)
694 DEFUTST (scm_to_ulong_long)
696 DEFSTST (scm_to_ssize_t)
697 DEFUTST (scm_to_size_t)
699 DEFSTST (scm_to_int8)
700 DEFUTST (scm_to_uint8)
701 DEFSTST (scm_to_int16)
702 DEFUTST (scm_to_uint16)
703 DEFSTST (scm_to_int32)
704 DEFUTST (scm_to_uint32)
705 DEFSTST (scm_to_int64)
706 DEFUTST (scm_to_uint64)
708 #define TEST_8S(v,f,r,re,te) test_8s (v, tst_##f, #f, r, re, te)
709 #define TEST_8U(v,f,r,re,te) test_8u (v, tst_##f, #f, r, re, te)
715 TEST_7U (scm_from_uchar, 91, "91");
716 TEST_7S (scm_from_schar, 91, "91");
717 TEST_7S (scm_from_char, 91, "91");
718 TEST_7S (scm_from_short, -911, "-911");
719 TEST_7U (scm_from_ushort, 911, "911");
720 TEST_7S (scm_from_int, 911, "911");
721 TEST_7U (scm_from_uint, 911, "911");
722 TEST_7S (scm_from_long, 911, "911");
723 TEST_7U (scm_from_ulong, 911, "911");
724 #if SCM_SIZEOF_LONG_LONG != 0
725 TEST_7S (scm_from_long_long, 911, "911");
726 TEST_7U (scm_from_ulong_long, 911, "911");
728 TEST_7U (scm_from_size_t, 911, "911");
729 TEST_7S (scm_from_ssize_t, 911, "911");
731 TEST_7S (scm_from_int8, -128, "-128");
732 TEST_7S (scm_from_int8, 127, "127");
733 TEST_7S (scm_from_int8, 128, "-128");
734 TEST_7U (scm_from_uint8, 255, "255");
736 TEST_7S (scm_from_int16, -32768, "-32768");
737 TEST_7S (scm_from_int16, 32767, "32767");
738 TEST_7S (scm_from_int16, 32768, "-32768");
739 TEST_7U (scm_from_uint16, 65535, "65535");
741 TEST_7S (scm_from_int32, SCM_T_INT32_MIN, "-2147483648");
742 TEST_7S (scm_from_int32, SCM_T_INT32_MAX, "2147483647");
743 TEST_7S (scm_from_int32, SCM_T_INT32_MAX+1LL, "-2147483648");
744 TEST_7U (scm_from_uint32, SCM_T_UINT32_MAX, "4294967295");
746 TEST_7S (scm_from_int64, SCM_T_INT64_MIN, "-9223372036854775808");
747 TEST_7S (scm_from_int64, SCM_T_INT64_MAX, "9223372036854775807");
748 TEST_7U (scm_from_uint64, SCM_T_UINT64_MAX, "18446744073709551615");
750 TEST_8S ("91", scm_to_schar, 91, 0, 0);
751 TEST_8U ("91", scm_to_uchar, 91, 0, 0);
752 TEST_8S ("91", scm_to_char, 91, 0, 0);
753 TEST_8S ("-911", scm_to_short, -911, 0, 0);
754 TEST_8U ("911", scm_to_ushort, 911, 0, 0);
755 TEST_8S ("-911", scm_to_int, -911, 0, 0);
756 TEST_8U ("911", scm_to_uint, 911, 0, 0);
757 TEST_8S ("-911", scm_to_long, -911, 0, 0);
758 TEST_8U ("911", scm_to_ulong, 911, 0, 0);
759 #if SCM_SIZEOF_LONG_LONG != 0
760 TEST_8S ("-911", scm_to_long_long, -911, 0, 0);
761 TEST_8U ("911", scm_to_ulong_long, 911, 0, 0);
763 TEST_8U ("911", scm_to_size_t, 911, 0, 0);
764 TEST_8S ("911", scm_to_ssize_t, 911, 0, 0);
766 TEST_8S ("-128", scm_to_int8, SCM_T_INT8_MIN, 0, 0);
767 TEST_8S ("127", scm_to_int8, SCM_T_INT8_MAX, 0, 0);
768 TEST_8S ("128", scm_to_int8, 0, 1, 0);
769 TEST_8S ("#f", scm_to_int8, 0, 0, 1);
770 TEST_8U ("255", scm_to_uint8, SCM_T_UINT8_MAX, 0, 0);
771 TEST_8U ("256", scm_to_uint8, 0, 1, 0);
772 TEST_8U ("-1", scm_to_uint8, 0, 1, 0);
773 TEST_8U ("#f", scm_to_uint8, 0, 0, 1);
775 TEST_8S ("-32768", scm_to_int16, SCM_T_INT16_MIN, 0, 0);
776 TEST_8S ("32767", scm_to_int16, SCM_T_INT16_MAX, 0, 0);
777 TEST_8S ("32768", scm_to_int16, 0, 1, 0);
778 TEST_8S ("#f", scm_to_int16, 0, 0, 1);
779 TEST_8U ("65535", scm_to_uint16, SCM_T_UINT16_MAX, 0, 0);
780 TEST_8U ("65536", scm_to_uint16, 0, 1, 0);
781 TEST_8U ("-1", scm_to_uint16, 0, 1, 0);
782 TEST_8U ("#f", scm_to_uint16, 0, 0, 1);
784 TEST_8S ("-2147483648", scm_to_int32, SCM_T_INT32_MIN, 0, 0);
785 TEST_8S ("2147483647", scm_to_int32, SCM_T_INT32_MAX, 0, 0);
786 TEST_8S ("2147483648", scm_to_int32, 0, 1, 0);
787 TEST_8S ("#f", scm_to_int32, 0, 0, 1);
788 TEST_8U ("4294967295", scm_to_uint32, SCM_T_UINT32_MAX, 0, 0);
789 TEST_8U ("4294967296", scm_to_uint32, 0, 1, 0);
790 TEST_8U ("-1", scm_to_uint32, 0, 1, 0);
791 TEST_8U ("#f", scm_to_uint32, 0, 0, 1);
793 TEST_8S ("-9223372036854775808", scm_to_int64, SCM_T_INT64_MIN, 0, 0);
794 TEST_8S ("9223372036854775807", scm_to_int64, SCM_T_INT64_MAX, 0, 0);
795 TEST_8S ("9223372036854775808", scm_to_int64, 0, 1, 0);
796 TEST_8S ("#f", scm_to_int64, 0, 0, 1);
797 TEST_8U ("18446744073709551615", scm_to_uint64, SCM_T_UINT64_MAX, 0, 0);
798 TEST_8U ("18446744073709551616", scm_to_uint64, 0, 1, 0);
799 TEST_8U ("-1", scm_to_uint64, 0, 1, 0);
800 TEST_8U ("#f", scm_to_uint64, 0, 0, 1);
805 test_9 (double val, const char *result)
807 SCM res = scm_c_eval_string (result);
808 if (scm_is_false (scm_eqv_p (res, scm_from_double (val))))
810 fprintf (stderr, "fail: scm_from_double (%g) == %s\n", val, result);
815 /* The `infinity' and `not-a-number' values. */
816 static double guile_Inf, guile_NaN;
818 /* Initialize GUILE_INF and GUILE_NAN. Taken from `guile_ieee_init ()' in
819 `libguile/numbers.c'. */
824 /* C99 INFINITY, when available.
825 FIXME: The standard allows for INFINITY to be something that overflows
826 at compile time. We ought to have a configure test to check for that
827 before trying to use it. (But in practice we believe this is not a
828 problem on any system guile is likely to target.) */
829 guile_Inf = INFINITY;
832 extern unsigned int DINFINITY[2];
833 guile_Inf = (*((double *) (DINFINITY)));
840 if (guile_Inf == tmp)
847 /* C99 NAN, when available */
852 extern unsigned int DQNAN[2];
853 guile_NaN = (*((double *)(DQNAN)));
856 guile_NaN = guile_Inf / guile_Inf;
864 test_9 (0.25, "0.25");
866 test_9 (guile_Inf, "+inf.0");
867 test_9 (-guile_Inf, "-inf.0");
868 test_9 (guile_NaN, "+nan.0");
877 to_double_body (void *data)
879 to_double_data *d = (to_double_data *)data;
880 d->result = scm_to_double (d->val);
885 test_10 (const char *val, double result, int type_error)
888 data.val = scm_c_eval_string (val);
892 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
893 to_double_body, &data,
894 wrong_type_handler, NULL)))
897 "fail: scm_double (%s) -> wrong type\n", val);
903 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
904 to_double_body, &data,
906 || data.result != result)
909 "fail: scm_to_double (%s) = %g\n", val, result);
918 test_10 ("#f", 0.0, 1);
919 test_10 ("12", 12.0, 0);
920 test_10 ("0.25", 0.25, 0);
921 test_10 ("1/4", 0.25, 0);
922 test_10 ("+inf.0", guile_Inf, 0);
923 test_10 ("-inf.0",-guile_Inf, 0);
924 test_10 ("+1i", 0.0, 1);
930 } to_locale_string_data;
933 to_locale_string_body (void *data)
935 to_locale_string_data *d = (to_locale_string_data *)data;
936 d->result = scm_to_locale_string (d->val);
941 test_11 (const char *str, const char *result, int misc_error, int type_error)
943 to_locale_string_data data;
944 data.val = scm_c_eval_string (str);
949 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
950 to_locale_string_body, &data,
951 misc_error_handler, NULL)))
954 "fail: scm_to_locale_string (%s) -> misc error\n", str);
960 if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
961 to_locale_string_body, &data,
962 wrong_type_handler, NULL)))
965 "fail: scm_to_locale_string (%s) -> wrong type\n", str);
971 if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
972 to_locale_string_body, &data,
974 || data.result == NULL || strcmp (data.result, result))
977 "fail: scm_to_locale_string (%s) = %s\n", str, result);
986 test_locale_strings ()
988 const char *lstr = "This is not a string.";
994 if (!scm_is_string (scm_c_eval_string ("\"foo\"")))
996 fprintf (stderr, "fail: scm_is_string (\"foo\") = true\n");
1000 str = scm_from_locale_string (lstr);
1002 if (!scm_is_string (str))
1004 fprintf (stderr, "fail: scm_is_string (str) = true\n");
1008 lstr2 = scm_to_locale_string (str);
1009 if (strcmp (lstr, lstr2))
1011 fprintf (stderr, "fail: lstr = lstr2\n");
1017 len = scm_to_locale_stringbuf (str, buf, 15);
1018 if (len != strlen (lstr))
1020 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) = strlen(lstr)\n");
1025 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) no overrun\n");
1028 if (strncmp (lstr, buf, 15))
1030 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) = lstr\n");
1034 str2 = scm_from_locale_stringn (lstr, 10);
1036 if (!scm_is_string (str2))
1038 fprintf (stderr, "fail: scm_is_string (str2) = true\n");
1042 lstr2 = scm_to_locale_string (str2);
1043 if (strncmp (lstr, lstr2, 10))
1045 fprintf (stderr, "fail: lstr = lstr2\n");
1051 len = scm_to_locale_stringbuf (str2, buf, 20);
1054 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) = 10\n");
1059 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) no overrun\n");
1062 if (strncmp (lstr, buf, 10))
1064 fprintf (stderr, "fail: scm_to_locale_stringbuf (...) = lstr\n");
1068 lstr2 = scm_to_locale_stringn (str2, &len);
1071 fprintf (stderr, "fail: scm_to_locale_stringn, len = 10\n");
1075 test_11 ("#f", NULL, 0, 1);
1076 test_11 ("\"foo\"", "foo", 0, 0);
1077 test_11 ("(string #\\f #\\nul)", NULL, 1, 0);
1081 tests (void *data, int argc, char **argv)
1083 test_is_signed_integer ();
1084 test_is_unsigned_integer ();
1085 test_to_signed_integer ();
1086 test_to_unsigned_integer ();
1087 test_from_signed_integer ();
1088 test_from_unsigned_integer ();
1090 test_from_double ();
1092 test_locale_strings ();
1096 main (int argc, char *argv[])
1099 scm_boot_guile (argc, argv, tests, NULL);