guile18/test-suite/standalone/test-conversion.c

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