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