[bpt/guile.git] / test-suite / standalone / test-conversion.c

/* Copyright (C) 1999,2000,2001,2003,2004 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 */

#include "libguile.h"

#include <stdio.h>
#include <assert.h>

static void
test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
	int result)
{
  int r = scm_is_signed_integer (scm_c_eval_string (str), min, max);
  if (r != result)
    {
      fprintf (stderr, "fail: scm_is_signed_integer (%s, %Ld, %Ld) == %d\n",
	       str, min, max, result);
      exit (1);
    }
}

static void
test_is_signed_integer ()
{
  test_1 ("'foo", 
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  0);
  test_1 ("3.0", 
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  0);
  test_1 ("(inexact->exact 3.0)", 
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  1);
  test_1 ("3.5",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  0);
  test_1 ("most-positive-fixnum",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  1);
  test_1 ("(+ most-positive-fixnum 1)",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  1);
  test_1 ("most-negative-fixnum",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  1);
  test_1 ("(- most-negative-fixnum 1)",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  1);
  if (sizeof (scm_t_intmax) == 8)
    {
      test_1 ("(- (expt 2 63) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      1);
      test_1 ("(expt 2 63)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      0);
      test_1 ("(- (expt 2 63))",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      1);
      test_1 ("(- (- (expt 2 63)) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      0);
    }
  else if (sizeof (scm_t_intmax) == 4)
    {
      test_1 ("(- (expt 2 31) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      1);
      test_1 ("(expt 2 31)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      0);
      test_1 ("(- (expt 2 31))",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      1);
      test_1 ("(- (- (expt 2 31)) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      0);
    }
  else
    fprintf (stderr, "NOTE: skipped some tests.\n");

  /* bignum with range that fits into fixnum. */
  test_1 ("(+ most-positive-fixnum 1)",
	  -32768, 32767,
	  0);

  /* bignum with range that doesn't fit into fixnum, but probably
     fits into long. */
  test_1 ("(+ most-positive-fixnum 1)",
	  SCM_MOST_NEGATIVE_FIXNUM-1, SCM_MOST_POSITIVE_FIXNUM+1,
	  1);
}

static void
test_2 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
	int result)
{
  int r = scm_is_unsigned_integer (scm_c_eval_string (str), min, max);
  if (r != result)
    {
      fprintf (stderr, "fail: scm_is_unsigned_integer (%s, %Lu, %Lu) == %d\n",
	       str, min, max, result);
      exit (1);
    }
}

static void
test_is_unsigned_integer ()
{
  test_2 ("'foo", 
	  0, SCM_T_UINTMAX_MAX,
	  0);
  test_2 ("3.0", 
	  0, SCM_T_UINTMAX_MAX,
	  0);
  test_2 ("(inexact->exact 3.0)", 
	  0, SCM_T_UINTMAX_MAX,
	  1);
  test_2 ("3.5",
	  0, SCM_T_UINTMAX_MAX,
	  0);
  test_2 ("most-positive-fixnum",
	  0, SCM_T_UINTMAX_MAX,
	  1);
  test_2 ("(+ most-positive-fixnum 1)",
	  0, SCM_T_UINTMAX_MAX,
	  1);
  test_2 ("most-negative-fixnum",
	  0, SCM_T_UINTMAX_MAX,
	  0);
  test_2 ("(- most-negative-fixnum 1)",
	  0, SCM_T_UINTMAX_MAX,
	  0);
  if (sizeof (scm_t_intmax) == 8)
    {
      test_2 ("(- (expt 2 64) 1)",
	      0, SCM_T_UINTMAX_MAX,
	      1);
      test_2 ("(expt 2 64)",
	      0, SCM_T_UINTMAX_MAX,
	      0);
    }
  else if (sizeof (scm_t_intmax) == 4)
    {
      test_2 ("(- (expt 2 32) 1)",
	      0, SCM_T_UINTMAX_MAX,
	      1);
      test_2 ("(expt 2 32)",
	      0, SCM_T_UINTMAX_MAX,
	      0);
    }
  else
    fprintf (stderr, "NOTE: skipped some tests.\n");

  /* bignum with range that fits into fixnum. */
  test_2 ("(+ most-positive-fixnum 1)",
	  0, 32767,
	  0);

  /* bignum with range that doesn't fit into fixnum, but probably
     fits into long. */
  test_2 ("(+ most-positive-fixnum 1)",
	  0, SCM_MOST_POSITIVE_FIXNUM+1,
	  1);
}

typedef struct {
  SCM val;
  scm_t_intmax min, max;
  scm_t_intmax result;
} to_signed_data;

static SCM
out_of_range_handler (void *data, SCM key, SCM args)
{
  return scm_equal_p (key, scm_str2symbol ("out-of-range"));
}

static SCM
wrong_type_handler (void *data, SCM key, SCM args)
{
  return scm_equal_p (key, scm_str2symbol ("wrong-type-arg"));
}

static SCM
any_handler (void *data, SCM key, SCM args)
{
  return SCM_BOOL_T;
}

static SCM
to_signed_integer_body (void *data)
{
  to_signed_data *d = (to_signed_data *)data;
  d->result = scm_to_signed_integer (d->val, d->min, d->max);
  return SCM_BOOL_F;
}

static void
test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
	scm_t_intmax result, int range_error, int type_error)
{
  to_signed_data data;
  data.val = scm_c_eval_string (str);
  data.min = min;
  data.max = max;
  
  if (range_error)
    {
      if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
					    to_signed_integer_body, &data,
					    out_of_range_handler, NULL)))
	{
	  fprintf (stderr,
		   "fail: scm_to_signed_int (%s, %Ld, %Ld) -> out of range\n",
		   str, min, max);
	  exit (1);
	}
    }
  else if (type_error)
    {
      if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
					    to_signed_integer_body, &data,
					    wrong_type_handler, NULL)))
	{
	  fprintf (stderr,
		   "fail: scm_to_signed_int (%s, %Ld, %Ld) -> wrong type\n",
		   str, min, max);
	  exit (1);
	}
    }
  else
    {
      if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
					   to_signed_integer_body, &data,
					   any_handler, NULL))
	  || data.result != result)
	{
	  fprintf (stderr,
		   "fail: scm_to_signed_int (%s, %Ld, %Ld) = %Ld\n",
		   str, min, max, result);
	  exit (1);
	}
    }
}

static void
test_to_signed_integer ()
{
  test_3 ("'foo",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  0, 0, 1);
  test_3 ("3.5",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  0, 0, 1);
  test_3 ("12",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  12, 0, 0);
  test_3 ("1000",
	  -999, 999,
	  0, 1, 0);
  test_3 ("-1000",
	  -999, 999,
	  0, 1, 0);
  test_3 ("most-positive-fixnum",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  SCM_MOST_POSITIVE_FIXNUM, 0, 0);
  test_3 ("most-negative-fixnum",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  SCM_MOST_NEGATIVE_FIXNUM, 0, 0);
  test_3 ("(+ most-positive-fixnum 1)",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
  test_3 ("(- most-negative-fixnum 1)",
	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	  SCM_MOST_NEGATIVE_FIXNUM-1, 0, 0);
  if (sizeof (scm_t_intmax) == 8)
    {
      test_3 ("(- (expt 2 63) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      SCM_T_INTMAX_MAX, 0, 0);
      test_3 ("(+ (- (expt 2 63)) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      SCM_T_INTMAX_MIN+1, 0, 0);
      test_3 ("(- (expt 2 63))",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      SCM_T_INTMAX_MIN, 0, 0);
      test_3 ("(expt 2 63)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      0, 1, 0);
      test_3 ("(- (- (expt 2 63)) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      0, 1, 0);
    }
  else if (sizeof (scm_t_intmax) == 4)
    {
      test_3 ("(- (expt 2 31) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      SCM_T_INTMAX_MAX, 0, 0);
      test_3 ("(+ (- (expt 2 31)) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      SCM_T_INTMAX_MIN+1, 0, 0);
      test_3 ("(- (expt 2 31))",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      SCM_T_INTMAX_MIN, 0, 0);
      test_3 ("(expt 2 31)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      0, 1, 0);
      test_3 ("(- (- (expt 2 31)) 1)",
	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	      0, 1, 0);
    }
  else
    fprintf (stderr, "NOTE: skipped some tests.\n");
}

typedef struct {
  SCM val;
  scm_t_uintmax min, max;
  scm_t_uintmax result;
} to_unsigned_data;

static SCM
to_unsigned_integer_body (void *data)
{
  to_unsigned_data *d = (to_unsigned_data *)data;
  d->result = scm_to_unsigned_integer (d->val, d->min, d->max);
  return SCM_BOOL_F;
}

static void
test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
	scm_t_uintmax result, int range_error, int type_error)
{
  to_unsigned_data data;
  data.val = scm_c_eval_string (str);
  data.min = min;
  data.max = max;
  
  if (range_error)
    {
      if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
					    to_unsigned_integer_body, &data,
					    out_of_range_handler, NULL)))
	{
	  fprintf (stderr,
		   "fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> out of range\n",
		   str, min, max);
	  exit (1);
	}
    }
  else if (type_error)
    {
      if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
					    to_unsigned_integer_body, &data,
					    wrong_type_handler, NULL)))
	{
	  fprintf (stderr,
		   "fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> wrong type\n",
		   str, min, max);
	  exit (1);
	}
    }
  else
    {
      if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
					   to_unsigned_integer_body, &data,
					   any_handler, NULL))
	  || data.result != result)
	{
	  fprintf (stderr,
		   "fail: scm_to_unsigned_int (%s, %Lu, %Lu) == %Lu\n",
		   str, min, max, result);
	  exit (1);
	}
    }
}

static void
test_to_unsigned_integer ()
{
  test_4 ("'foo",
	  0, SCM_T_UINTMAX_MAX,
	  0, 0, 1);
  test_4 ("3.5",
	  0, SCM_T_UINTMAX_MAX,
	  0, 0, 1);
  test_4 ("12",
	  0, SCM_T_UINTMAX_MAX,
	  12, 0, 0);
  test_4 ("1000",
	  0, 999,
	  0, 1, 0);
  test_4 ("most-positive-fixnum",
	  0, SCM_T_UINTMAX_MAX,
	  SCM_MOST_POSITIVE_FIXNUM, 0, 0);
  test_4 ("(+ most-positive-fixnum 1)",
	  0, SCM_T_UINTMAX_MAX,
	  SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
  if (sizeof (scm_t_intmax) == 8)
    {
      test_4 ("(- (expt 2 64) 1)",
	      0, SCM_T_UINTMAX_MAX,
	      SCM_T_UINTMAX_MAX, 0, 0);
      test_4 ("(expt 2 64)",
	      0, SCM_T_UINTMAX_MAX,
	      0, 1, 0);
    }
  else if (sizeof (scm_t_intmax) == 4)
    {
      test_4 ("(- (expt 2 32) 1)",
	      0, SCM_T_UINTMAX_MAX,
	      SCM_T_UINTMAX_MAX, 0, 0);
      test_4 ("(expt 2 32)",
	      0, SCM_T_UINTMAX_MAX,
	      0, 1, 0);
    }
  else
    fprintf (stderr, "NOTE: skipped some tests.\n");
}

static void
test_5 (scm_t_intmax val, const char *result)
{
  SCM res = scm_c_eval_string (result);
  if (scm_is_false (scm_equal_p (scm_from_signed_integer (val), res)))
    {
      fprintf (stderr, "fail: scm_from_signed_integer (%Ld) == %s\n",
	       val, result);
      exit (1);
    }
}

static void
test_from_signed_integer ()
{
  test_5 (12, "12");
  if (sizeof (scm_t_intmax) == 8)
    {
      test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 63) 1)");
      test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 63))");
    }
  else if (sizeof (scm_t_intmax) == 4)
    {
      test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 31) 1)");
      test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 31))");
    }
  test_5 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
  test_5 (SCM_MOST_NEGATIVE_FIXNUM, "most-negative-fixnum");
  test_5 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
  test_5 (SCM_MOST_NEGATIVE_FIXNUM-1, "(- most-negative-fixnum 1)");
}

static void
test_6 (scm_t_uintmax val, const char *result)
{
  SCM res = scm_c_eval_string (result);
  if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res)))
    {
      fprintf (stderr, "fail: scm_from_unsigned_integer (%Lu) == %s\n",
	       val, result);
      exit (1);
    }
}

static void
test_from_unsigned_integer ()
{
  test_6 (12, "12");
  if (sizeof (scm_t_intmax) == 8)
    {
      test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 64) 1)");
    }
  else if (sizeof (scm_t_intmax) == 4)
    {
      test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 32) 1)");
    }
  test_6 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
  test_6 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
}

static void
test_int_sizes ()
{
  SCM n = scm_from_int (91);

  /* Just list them here to check whether the macros expand to correct
     code. */
     
  scm_from_schar (91);
  scm_from_uchar (91);
  scm_from_char (91);
  scm_from_short (91);
  scm_from_int (91);
  scm_from_long (91);
#if SCM_SIZEOF_LONG_LONG != 0
  scm_from_long_long (91);
  scm_from_ulong_long (91);
#endif
  scm_from_size_t (91);
  scm_from_ssize_t (91);
  scm_from_int8 (91);
  scm_from_uint8 (91);
  scm_from_int16 (91);
  scm_from_uint16 (91);
  scm_from_int32 (91);
  scm_from_uint32 (91);
#if SCM_HAVE_T_INT64
  scm_from_int64 (91);
  scm_from_uint64 (91);
#endif

  scm_to_schar (n);
  scm_to_uchar (n);
  scm_to_char (n);
  scm_to_short (n);
  scm_to_int (n);
  scm_to_long (n);
#if SCM_SIZEOF_LONG_LONG != 0
  scm_to_long_long (n);
  scm_to_ulong_long (n);
#endif
  scm_to_size_t (n);
  scm_to_ssize_t (n);
  scm_to_int8 (n);
  scm_to_uint8 (n);
  scm_to_int16 (n);
  scm_to_uint16 (n);
  scm_to_int32 (n);
  scm_to_uint32 (n);
#if SCM_HAVE_T_INT64
  scm_to_int64 (n);
  scm_to_uint64 (n);
#endif

}

int
main (int argc, char *argv[])
{
  scm_init_guile();
  test_is_signed_integer ();
  test_is_unsigned_integer ();
  test_to_signed_integer ();
  test_to_unsigned_integer ();
  test_from_signed_integer ();
  test_from_unsigned_integer ();
  test_int_sizes ();
  return 0;
}
Commit	Line	Data
170bb182 MV	1	/* Copyright (C) 1999,2000,2001,2003,2004 Free Software Foundation, Inc.
	2	*
	3	* This library is free software; you can redistribute it and/or
	4	* modify it under the terms of the GNU Lesser General Public
	5	* License as published by the Free Software Foundation; either
	6	* version 2.1 of the License, or (at your option) any later version.
	7	*
	8	* This library is distributed in the hope that it will be useful,
	9	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	11	* Lesser General Public License for more details.
	12	*
	13	* You should have received a copy of the GNU Lesser General Public
	14	* License along with this library; if not, write to the Free Software
	15	* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	16	*/
	17
	18	#include "libguile.h"
	19
	20	#include <stdio.h>
	21	#include <assert.h>
	22
170bb182 MV	23	static void
	24	test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
	25	int result)
	26	{
	27	int r = scm_is_signed_integer (scm_c_eval_string (str), min, max);
	28	if (r != result)
	29	{
	30	fprintf (stderr, "fail: scm_is_signed_integer (%s, %Ld, %Ld) == %d\n",
	31	str, min, max, result);
	32	exit (1);
	33	}
	34	}
	35
	36	static void
	37	test_is_signed_integer ()
	38	{
	39	test_1 ("'foo",
	40	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	41	0);
	42	test_1 ("3.0",
abe1308c MV	43	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	44	0);
	45	test_1 ("(inexact->exact 3.0)",
170bb182 MV	46	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	47	1);
	48	test_1 ("3.5",
	49	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	50	0);
	51	test_1 ("most-positive-fixnum",
	52	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	53	1);
	54	test_1 ("(+ most-positive-fixnum 1)",
	55	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	56	1);
	57	test_1 ("most-negative-fixnum",
	58	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	59	1);
	60	test_1 ("(- most-negative-fixnum 1)",
	61	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	62	1);
	63	if (sizeof (scm_t_intmax) == 8)
	64	{
	65	test_1 ("(- (expt 2 63) 1)",
	66	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	67	1);
	68	test_1 ("(expt 2 63)",
	69	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	70	0);
	71	test_1 ("(- (expt 2 63))",
	72	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	73	1);
	74	test_1 ("(- (- (expt 2 63)) 1)",
	75	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	76	0);
	77	}
	78	else if (sizeof (scm_t_intmax) == 4)
	79	{
	80	test_1 ("(- (expt 2 31) 1)",
	81	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	82	1);
	83	test_1 ("(expt 2 31)",
	84	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	85	0);
	86	test_1 ("(- (expt 2 31))",
	87	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	88	1);
	89	test_1 ("(- (- (expt 2 31)) 1)",
	90	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	91	0);
	92	}
	93	else
	94	fprintf (stderr, "NOTE: skipped some tests.\n");
	95
	96	/* bignum with range that fits into fixnum. */
	97	test_1 ("(+ most-positive-fixnum 1)",
	98	-32768, 32767,
	99	0);
	100
	101	/* bignum with range that doesn't fit into fixnum, but probably
	102	fits into long. */
	103	test_1 ("(+ most-positive-fixnum 1)",
	104	SCM_MOST_NEGATIVE_FIXNUM-1, SCM_MOST_POSITIVE_FIXNUM+1,
	105	1);
	106	}
	107
	108	static void
	109	test_2 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
110	int result)
111	{
112	int r = scm_is_unsigned_integer (scm_c_eval_string (str), min, max);
113	if (r != result)
114	{
115	fprintf (stderr, "fail: scm_is_unsigned_integer (%s, %Lu, %Lu) == %d\n",
116	str, min, max, result);
117	exit (1);
118	}
119	}
120
121	static void
122	test_is_unsigned_integer ()
123	{
124	test_2 ("'foo",
afdb04ef	125	0, SCM_T_UINTMAX_MAX,
170bb182 MV	126	0);
170bb182 MV	127	test_2 ("3.0",
abe1308c MV	128	0, SCM_T_UINTMAX_MAX,
	129	0);
	130	test_2 ("(inexact->exact 3.0)",
afdb04ef	131	0, SCM_T_UINTMAX_MAX,
170bb182 MV	132	1);
170bb182 MV	133	test_2 ("3.5",
afdb04ef	134	0, SCM_T_UINTMAX_MAX,
170bb182 MV	135	0);
170bb182 MV	136	test_2 ("most-positive-fixnum",
afdb04ef	137	0, SCM_T_UINTMAX_MAX,
170bb182 MV	138	1);
170bb182 MV	139	test_2 ("(+ most-positive-fixnum 1)",
afdb04ef	140	0, SCM_T_UINTMAX_MAX,
170bb182 MV	141	1);
170bb182 MV	142	test_2 ("most-negative-fixnum",
afdb04ef	143	0, SCM_T_UINTMAX_MAX,
170bb182 MV	144	0);
170bb182 MV	145	test_2 ("(- most-negative-fixnum 1)",
afdb04ef	146	0, SCM_T_UINTMAX_MAX,
170bb182 MV	147	0);
	148	if (sizeof (scm_t_intmax) == 8)
	149	{
	150	test_2 ("(- (expt 2 64) 1)",
afdb04ef	151	0, SCM_T_UINTMAX_MAX,
170bb182 MV	152	1);
170bb182 MV	153	test_2 ("(expt 2 64)",
afdb04ef	154	0, SCM_T_UINTMAX_MAX,
170bb182 MV	155	0);
	156	}
	157	else if (sizeof (scm_t_intmax) == 4)
	158	{
	159	test_2 ("(- (expt 2 32) 1)",
afdb04ef	160	0, SCM_T_UINTMAX_MAX,
170bb182 MV	161	1);
170bb182 MV	162	test_2 ("(expt 2 32)",
afdb04ef	163	0, SCM_T_UINTMAX_MAX,
170bb182 MV	164	0);
	165	}
	166	else
	167	fprintf (stderr, "NOTE: skipped some tests.\n");
	168
	169	/* bignum with range that fits into fixnum. */
	170	test_2 ("(+ most-positive-fixnum 1)",
	171	0, 32767,
	172	0);
	173
	174	/* bignum with range that doesn't fit into fixnum, but probably
	175	fits into long. */
	176	test_2 ("(+ most-positive-fixnum 1)",
	177	0, SCM_MOST_POSITIVE_FIXNUM+1,
	178	1);
	179	}
	180
	181	typedef struct {
	182	SCM val;
	183	scm_t_intmax min, max;
	184	scm_t_intmax result;
	185	} to_signed_data;
	186
	187	static SCM
	188	out_of_range_handler (void *data, SCM key, SCM args)
	189	{
	190	return scm_equal_p (key, scm_str2symbol ("out-of-range"));
	191	}
	192
	193	static SCM
	194	wrong_type_handler (void *data, SCM key, SCM args)
	195	{
	196	return scm_equal_p (key, scm_str2symbol ("wrong-type-arg"));
	197	}
	198
	199	static SCM
	200	any_handler (void *data, SCM key, SCM args)
	201	{
	202	return SCM_BOOL_T;
	203	}
	204
	205	static SCM
	206	to_signed_integer_body (void *data)
	207	{
	208	to_signed_data d = (to_signed_data )data;
	209	d->result = scm_to_signed_integer (d->val, d->min, d->max);
	210	return SCM_BOOL_F;
	211	}
	212
	213	static void
	214	test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
	215	scm_t_intmax result, int range_error, int type_error)
	216	{
	217	to_signed_data data;
	218	data.val = scm_c_eval_string (str);
	219	data.min = min;
	220	data.max = max;
	221
	222	if (range_error)
	223	{
	224	if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
	225	to_signed_integer_body, &data,
	226	out_of_range_handler, NULL)))
	227	{
228	fprintf (stderr,
229	"fail: scm_to_signed_int (%s, %Ld, %Ld) -> out of range\n",
230	str, min, max);
231	exit (1);
232	}
233	}
234	else if (type_error)
235	{
236	if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
237	to_signed_integer_body, &data,
238	wrong_type_handler, NULL)))
239	{
240	fprintf (stderr,
241	"fail: scm_to_signed_int (%s, %Ld, %Ld) -> wrong type\n",
242	str, min, max);
243	exit (1);
244	}
245	}
246	else
247	{
248	if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
249	to_signed_integer_body, &data,
250	any_handler, NULL))
251	\|\| data.result != result)
252	{
253	fprintf (stderr,
254	"fail: scm_to_signed_int (%s, %Ld, %Ld) = %Ld\n",
255	str, min, max, result);
256	exit (1);
257	}
258	}
259	}
260
261	static void
262	test_to_signed_integer ()
263	{
264	test_3 ("'foo",
265	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
266	0, 0, 1);
267	test_3 ("3.5",
268	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
269	0, 0, 1);
270	test_3 ("12",
271	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
272	12, 0, 0);
273	test_3 ("1000",
274	-999, 999,
275	0, 1, 0);
276	test_3 ("-1000",
277	-999, 999,
278	0, 1, 0);
279	test_3 ("most-positive-fixnum",
280	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
281	SCM_MOST_POSITIVE_FIXNUM, 0, 0);
282	test_3 ("most-negative-fixnum",
283	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
284	SCM_MOST_NEGATIVE_FIXNUM, 0, 0);
285	test_3 ("(+ most-positive-fixnum 1)",
286	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
287	SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
288	test_3 ("(- most-negative-fixnum 1)",
289	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
290	SCM_MOST_NEGATIVE_FIXNUM-1, 0, 0);
291	if (sizeof (scm_t_intmax) == 8)
292	{
293	test_3 ("(- (expt 2 63) 1)",
294	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
295	SCM_T_INTMAX_MAX, 0, 0);
296	test_3 ("(+ (- (expt 2 63)) 1)",
297	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
298	SCM_T_INTMAX_MIN+1, 0, 0);
299	test_3 ("(- (expt 2 63))",
300	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
301	SCM_T_INTMAX_MIN, 0, 0);
302	test_3 ("(expt 2 63)",
303	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
304	0, 1, 0);
305	test_3 ("(- (- (expt 2 63)) 1)",
306	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
307	0, 1, 0);
308	}
309	else if (sizeof (scm_t_intmax) == 4)
310	{
311	test_3 ("(- (expt 2 31) 1)",
312	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
313	SCM_T_INTMAX_MAX, 0, 0);
314	test_3 ("(+ (- (expt 2 31)) 1)",
315	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
316	SCM_T_INTMAX_MIN+1, 0, 0);
317	test_3 ("(- (expt 2 31))",
318	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
319	SCM_T_INTMAX_MIN, 0, 0);
320	test_3 ("(expt 2 31)",
321	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
322	0, 1, 0);
323	test_3 ("(- (- (expt 2 31)) 1)",
324	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
325	0, 1, 0);
326	}
327	else
328	fprintf (stderr, "NOTE: skipped some tests.\n");
329	}
330
331	typedef struct {
332	SCM val;
333	scm_t_uintmax min, max;
334	scm_t_uintmax result;
335	} to_unsigned_data;
336
337	static SCM
338	to_unsigned_integer_body (void *data)
339	{
340	to_unsigned_data d = (to_unsigned_data )data;
341	d->result = scm_to_unsigned_integer (d->val, d->min, d->max);
342	return SCM_BOOL_F;
343	}
344
345	static void
346	test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
347	scm_t_uintmax result, int range_error, int type_error)
348	{
349	to_unsigned_data data;
350	data.val = scm_c_eval_string (str);
351	data.min = min;
352	data.max = max;
353
354	if (range_error)
355	{
356	if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
357	to_unsigned_integer_body, &data,
358	out_of_range_handler, NULL)))
359	{
360	fprintf (stderr,
361	"fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> out of range\n",
362	str, min, max);
363	exit (1);
364	}
365	}
366	else if (type_error)
367	{
368	if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
369	to_unsigned_integer_body, &data,
370	wrong_type_handler, NULL)))
371	{
372	fprintf (stderr,
373	"fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> wrong type\n",
374	str, min, max);
375	exit (1);
376	}
377	}
378	else
379	{
380	if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
381	to_unsigned_integer_body, &data,
382	any_handler, NULL))
383	\|\| data.result != result)
384	{
385	fprintf (stderr,
386	"fail: scm_to_unsigned_int (%s, %Lu, %Lu) == %Lu\n",
387	str, min, max, result);
388	exit (1);
389	}
390	}
391	}
392
393	static void
394	test_to_unsigned_integer ()
395	{
396	test_4 ("'foo",
afdb04ef	397	0, SCM_T_UINTMAX_MAX,
170bb182 MV	398	0, 0, 1);
170bb182 MV	399	test_4 ("3.5",
afdb04ef	400	0, SCM_T_UINTMAX_MAX,
170bb182 MV	401	0, 0, 1);
170bb182 MV	402	test_4 ("12",
afdb04ef	403	0, SCM_T_UINTMAX_MAX,
170bb182 MV	404	12, 0, 0);
	405	test_4 ("1000",
	406	0, 999,
	407	0, 1, 0);
	408	test_4 ("most-positive-fixnum",
afdb04ef	409	0, SCM_T_UINTMAX_MAX,
170bb182 MV	410	SCM_MOST_POSITIVE_FIXNUM, 0, 0);
170bb182 MV	411	test_4 ("(+ most-positive-fixnum 1)",
afdb04ef	412	0, SCM_T_UINTMAX_MAX,
170bb182 MV	413	SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
	414	if (sizeof (scm_t_intmax) == 8)
	415	{
	416	test_4 ("(- (expt 2 64) 1)",
afdb04ef	417	0, SCM_T_UINTMAX_MAX,
170bb182 MV	418	SCM_T_UINTMAX_MAX, 0, 0);
170bb182 MV	419	test_4 ("(expt 2 64)",
afdb04ef	420	0, SCM_T_UINTMAX_MAX,
170bb182 MV	421	0, 1, 0);
	422	}
	423	else if (sizeof (scm_t_intmax) == 4)
	424	{
	425	test_4 ("(- (expt 2 32) 1)",
afdb04ef	426	0, SCM_T_UINTMAX_MAX,
170bb182 MV	427	SCM_T_UINTMAX_MAX, 0, 0);
170bb182 MV	428	test_4 ("(expt 2 32)",
afdb04ef	429	0, SCM_T_UINTMAX_MAX,
170bb182 MV	430	0, 1, 0);
	431	}
	432	else
	433	fprintf (stderr, "NOTE: skipped some tests.\n");
	434	}
	435
	436	static void
	437	test_5 (scm_t_intmax val, const char *result)
	438	{
	439	SCM res = scm_c_eval_string (result);
	440	if (scm_is_false (scm_equal_p (scm_from_signed_integer (val), res)))
	441	{
	442	fprintf (stderr, "fail: scm_from_signed_integer (%Ld) == %s\n",
	443	val, result);
	444	exit (1);
	445	}
	446	}
	447
	448	static void
	449	test_from_signed_integer ()
	450	{
	451	test_5 (12, "12");
	452	if (sizeof (scm_t_intmax) == 8)
	453	{
	454	test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 63) 1)");
	455	test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 63))");
	456	}
	457	else if (sizeof (scm_t_intmax) == 4)
	458	{
	459	test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 31) 1)");
	460	test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 31))");
	461	}
	462	test_5 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
	463	test_5 (SCM_MOST_NEGATIVE_FIXNUM, "most-negative-fixnum");
	464	test_5 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
	465	test_5 (SCM_MOST_NEGATIVE_FIXNUM-1, "(- most-negative-fixnum 1)");
	466	}
	467
	468	static void
	469	test_6 (scm_t_uintmax val, const char *result)
	470	{
	471	SCM res = scm_c_eval_string (result);
	472	if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res)))
	473	{
170bb182 MV	474	fprintf (stderr, "fail: scm_from_unsigned_integer (%Lu) == %s\n",
	475	val, result);
	476	exit (1);
	477	}
	478	}
	479
	480	static void
	481	test_from_unsigned_integer ()
	482	{
	483	test_6 (12, "12");
	484	if (sizeof (scm_t_intmax) == 8)
	485	{
	486	test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 64) 1)");
	487	}
	488	else if (sizeof (scm_t_intmax) == 4)
	489	{
	490	test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 32) 1)");
	491	}
	492	test_6 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
	493	test_6 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
	494	}
	495
afdb04ef MV	496	static void
	497	test_int_sizes ()
	498	{
	499	SCM n = scm_from_int (91);
	500
	501	/* Just list them here to check whether the macros expand to correct
	502	code. */
	503
	504	scm_from_schar (91);
	505	scm_from_uchar (91);
	506	scm_from_char (91);
	507	scm_from_short (91);
	508	scm_from_int (91);
	509	scm_from_long (91);
	510	#if SCM_SIZEOF_LONG_LONG != 0
	511	scm_from_long_long (91);
	512	scm_from_ulong_long (91);
	513	#endif
	514	scm_from_size_t (91);
	515	scm_from_ssize_t (91);
	516	scm_from_int8 (91);
	517	scm_from_uint8 (91);
	518	scm_from_int16 (91);
	519	scm_from_uint16 (91);
	520	scm_from_int32 (91);
	521	scm_from_uint32 (91);
	522	#if SCM_HAVE_T_INT64
	523	scm_from_int64 (91);
	524	scm_from_uint64 (91);
	525	#endif
	526
	527	scm_to_schar (n);
	528	scm_to_uchar (n);
	529	scm_to_char (n);
	530	scm_to_short (n);
	531	scm_to_int (n);
	532	scm_to_long (n);
	533	#if SCM_SIZEOF_LONG_LONG != 0
	534	scm_to_long_long (n);
	535	scm_to_ulong_long (n);
	536	#endif
	537	scm_to_size_t (n);
	538	scm_to_ssize_t (n);
	539	scm_to_int8 (n);
	540	scm_to_uint8 (n);
	541	scm_to_int16 (n);
	542	scm_to_uint16 (n);
	543	scm_to_int32 (n);
	544	scm_to_uint32 (n);
	545	#if SCM_HAVE_T_INT64
	546	scm_to_int64 (n);
	547	scm_to_uint64 (n);
	548	#endif
	549
	550	}
	551
170bb182 MV	552	int
	553	main (int argc, char *argv[])
	554	{
	555	scm_init_guile();
	556	test_is_signed_integer ();
	557	test_is_unsigned_integer ();
	558	test_to_signed_integer ();
	559	test_to_unsigned_integer ();
	560	test_from_signed_integer ();
	561	test_from_unsigned_integer ();
afdb04ef	562	test_int_sizes ();
170bb182 MV	563	return 0;
170bb182 MV	564	}