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