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