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