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