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