[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>

#define SCM_T_UINTMAX_MAX (~(scm_t_uintmax)0)
#define SCM_T_UINTMAX_MIN ((scm_t_uintmax)0)
#define SCM_T_INTMAX_MAX ((scm_t_intmax)(SCM_T_UINTMAX_MAX/2))
#define SCM_T_INTMAX_MIN (~SCM_T_INTMAX_MAX)

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,
	  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", 
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  0);
  test_2 ("3.0", 
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  1);
  test_2 ("3.5",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  0);
  test_2 ("most-positive-fixnum",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  1);
  test_2 ("(+ most-positive-fixnum 1)",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  1);
  test_2 ("most-negative-fixnum",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  0);
  test_2 ("(- most-negative-fixnum 1)",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  0);
  if (sizeof (scm_t_intmax) == 8)
    {
      test_2 ("(- (expt 2 64) 1)",
	      SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	      1);
      test_2 ("(expt 2 64)",
	      SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	      0);
    }
  else if (sizeof (scm_t_intmax) == 4)
    {
      test_2 ("(- (expt 2 32) 1)",
	      SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	      1);
      test_2 ("(expt 2 32)",
	      SCM_T_UINTMAX_MIN, 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",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  0, 0, 1);
  test_4 ("3.5",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  0, 0, 1);
  test_4 ("12",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  12, 0, 0);
  test_4 ("1000",
	  0, 999,
	  0, 1, 0);
  test_4 ("most-positive-fixnum",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  SCM_MOST_POSITIVE_FIXNUM, 0, 0);
  test_4 ("(+ most-positive-fixnum 1)",
	  SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	  SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
  if (sizeof (scm_t_intmax) == 8)
    {
      test_4 ("(- (expt 2 64) 1)",
	      SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	      SCM_T_UINTMAX_MAX, 0, 0);
      test_4 ("(expt 2 64)",
	      SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	      0, 1, 0);
    }
  else if (sizeof (scm_t_intmax) == 4)
    {
      test_4 ("(- (expt 2 32) 1)",
	      SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
	      SCM_T_UINTMAX_MAX, 0, 0);
      test_4 ("(expt 2 32)",
	      SCM_T_UINTMAX_MIN, 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)))
    {
      scm_write (scm_from_unsigned_integer (val), SCM_UNDEFINED);
      scm_newline (SCM_UNDEFINED);
      scm_write (res, SCM_UNDEFINED);
      scm_newline (SCM_UNDEFINED);

      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)");
}

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 ();
  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
	23	#define SCM_T_UINTMAX_MAX (~(scm_t_uintmax)0)
	24	#define SCM_T_UINTMAX_MIN ((scm_t_uintmax)0)
	25	#define SCM_T_INTMAX_MAX ((scm_t_intmax)(SCM_T_UINTMAX_MAX/2))
	26	#define SCM_T_INTMAX_MIN (~SCM_T_INTMAX_MAX)
	27
	28	static void
	29	test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
	30	int result)
	31	{
	32	int r = scm_is_signed_integer (scm_c_eval_string (str), min, max);
	33	if (r != result)
	34	{
	35	fprintf (stderr, "fail: scm_is_signed_integer (%s, %Ld, %Ld) == %d\n",
	36	str, min, max, result);
	37	exit (1);
	38	}
	39	}
	40
	41	static void
	42	test_is_signed_integer ()
	43	{
	44	test_1 ("'foo",
	45	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	46	0);
	47	test_1 ("3.0",
	48	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	49	1);
	50	test_1 ("3.5",
	51	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	52	0);
	53	test_1 ("most-positive-fixnum",
	54	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	55	1);
	56	test_1 ("(+ most-positive-fixnum 1)",
	57	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	58	1);
	59	test_1 ("most-negative-fixnum",
	60	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	61	1);
	62	test_1 ("(- most-negative-fixnum 1)",
	63	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
	64	1);
65	if (sizeof (scm_t_intmax) == 8)
66	{
67	test_1 ("(- (expt 2 63) 1)",
68	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
69	1);
70	test_1 ("(expt 2 63)",
71	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
72	0);
73	test_1 ("(- (expt 2 63))",
74	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
75	1);
76	test_1 ("(- (- (expt 2 63)) 1)",
77	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
78	0);
79	}
80	else if (sizeof (scm_t_intmax) == 4)
81	{
82	test_1 ("(- (expt 2 31) 1)",
83	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
84	1);
85	test_1 ("(expt 2 31)",
86	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
87	0);
88	test_1 ("(- (expt 2 31))",
89	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
90	1);
91	test_1 ("(- (- (expt 2 31)) 1)",
92	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
93	0);
94	}
95	else
96	fprintf (stderr, "NOTE: skipped some tests.\n");
97
98	/* bignum with range that fits into fixnum. */
99	test_1 ("(+ most-positive-fixnum 1)",
100	-32768, 32767,
101	0);
102
103	/* bignum with range that doesn't fit into fixnum, but probably
104	fits into long. */
105	test_1 ("(+ most-positive-fixnum 1)",
106	SCM_MOST_NEGATIVE_FIXNUM-1, SCM_MOST_POSITIVE_FIXNUM+1,
107	1);
108	}
109
110	static void
111	test_2 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
112	int result)
113	{
114	int r = scm_is_unsigned_integer (scm_c_eval_string (str), min, max);
115	if (r != result)
116	{
117	fprintf (stderr, "fail: scm_is_unsigned_integer (%s, %Lu, %Lu) == %d\n",
118	str, min, max, result);
119	exit (1);
120	}
121	}
122
123	static void
124	test_is_unsigned_integer ()
125	{
126	test_2 ("'foo",
127	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
128	0);
129	test_2 ("3.0",
130	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
131	1);
132	test_2 ("3.5",
133	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
134	0);
135	test_2 ("most-positive-fixnum",
136	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
137	1);
138	test_2 ("(+ most-positive-fixnum 1)",
139	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
140	1);
141	test_2 ("most-negative-fixnum",
142	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
143	0);
144	test_2 ("(- most-negative-fixnum 1)",
145	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
146	0);
147	if (sizeof (scm_t_intmax) == 8)
148	{
149	test_2 ("(- (expt 2 64) 1)",
150	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
151	1);
152	test_2 ("(expt 2 64)",
153	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
154	0);
155	}
156	else if (sizeof (scm_t_intmax) == 4)
157	{
158	test_2 ("(- (expt 2 32) 1)",
159	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
160	1);
161	test_2 ("(expt 2 32)",
162	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
163	0);
164	}
165	else
166	fprintf (stderr, "NOTE: skipped some tests.\n");
167
168	/* bignum with range that fits into fixnum. */
169	test_2 ("(+ most-positive-fixnum 1)",
170	0, 32767,
171	0);
172
173	/* bignum with range that doesn't fit into fixnum, but probably
174	fits into long. */
175	test_2 ("(+ most-positive-fixnum 1)",
176	0, SCM_MOST_POSITIVE_FIXNUM+1,
177	1);
178	}
179
180	typedef struct {
181	SCM val;
182	scm_t_intmax min, max;
183	scm_t_intmax result;
184	} to_signed_data;
185
186	static SCM
187	out_of_range_handler (void *data, SCM key, SCM args)
188	{
189	return scm_equal_p (key, scm_str2symbol ("out-of-range"));
190	}
191
192	static SCM
193	wrong_type_handler (void *data, SCM key, SCM args)
194	{
195	return scm_equal_p (key, scm_str2symbol ("wrong-type-arg"));
196	}
197
198	static SCM
199	any_handler (void *data, SCM key, SCM args)
200	{
201	return SCM_BOOL_T;
202	}
203
204	static SCM
205	to_signed_integer_body (void *data)
206	{
207	to_signed_data d = (to_signed_data )data;
208	d->result = scm_to_signed_integer (d->val, d->min, d->max);
209	return SCM_BOOL_F;
210	}
211
212	static void
213	test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
214	scm_t_intmax result, int range_error, int type_error)
215	{
216	to_signed_data data;
217	data.val = scm_c_eval_string (str);
218	data.min = min;
219	data.max = max;
220
221	if (range_error)
222	{
223	if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
224	to_signed_integer_body, &data,
225	out_of_range_handler, NULL)))
226	{
227	fprintf (stderr,
228	"fail: scm_to_signed_int (%s, %Ld, %Ld) -> out of range\n",
229	str, min, max);
230	exit (1);
231	}
232	}
233	else if (type_error)
234	{
235	if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
236	to_signed_integer_body, &data,
237	wrong_type_handler, NULL)))
238	{
239	fprintf (stderr,
240	"fail: scm_to_signed_int (%s, %Ld, %Ld) -> wrong type\n",
241	str, min, max);
242	exit (1);
243	}
244	}
245	else
246	{
247	if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
248	to_signed_integer_body, &data,
249	any_handler, NULL))
250	\|\| data.result != result)
251	{
252	fprintf (stderr,
253	"fail: scm_to_signed_int (%s, %Ld, %Ld) = %Ld\n",
254	str, min, max, result);
255	exit (1);
256	}
257	}
258	}
259
260	static void
261	test_to_signed_integer ()
262	{
263	test_3 ("'foo",
264	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
265	0, 0, 1);
266	test_3 ("3.5",
267	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
268	0, 0, 1);
269	test_3 ("12",
270	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
271	12, 0, 0);
272	test_3 ("1000",
273	-999, 999,
274	0, 1, 0);
275	test_3 ("-1000",
276	-999, 999,
277	0, 1, 0);
278	test_3 ("most-positive-fixnum",
279	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
280	SCM_MOST_POSITIVE_FIXNUM, 0, 0);
281	test_3 ("most-negative-fixnum",
282	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
283	SCM_MOST_NEGATIVE_FIXNUM, 0, 0);
284	test_3 ("(+ most-positive-fixnum 1)",
285	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
286	SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
287	test_3 ("(- most-negative-fixnum 1)",
288	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
289	SCM_MOST_NEGATIVE_FIXNUM-1, 0, 0);
290	if (sizeof (scm_t_intmax) == 8)
291	{
292	test_3 ("(- (expt 2 63) 1)",
293	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
294	SCM_T_INTMAX_MAX, 0, 0);
295	test_3 ("(+ (- (expt 2 63)) 1)",
296	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
297	SCM_T_INTMAX_MIN+1, 0, 0);
298	test_3 ("(- (expt 2 63))",
299	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
300	SCM_T_INTMAX_MIN, 0, 0);
301	test_3 ("(expt 2 63)",
302	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
303	0, 1, 0);
304	test_3 ("(- (- (expt 2 63)) 1)",
305	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
306	0, 1, 0);
307	}
308	else if (sizeof (scm_t_intmax) == 4)
309	{
310	test_3 ("(- (expt 2 31) 1)",
311	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
312	SCM_T_INTMAX_MAX, 0, 0);
313	test_3 ("(+ (- (expt 2 31)) 1)",
314	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
315	SCM_T_INTMAX_MIN+1, 0, 0);
316	test_3 ("(- (expt 2 31))",
317	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
318	SCM_T_INTMAX_MIN, 0, 0);
319	test_3 ("(expt 2 31)",
320	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
321	0, 1, 0);
322	test_3 ("(- (- (expt 2 31)) 1)",
323	SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
324	0, 1, 0);
325	}
326	else
327	fprintf (stderr, "NOTE: skipped some tests.\n");
328	}
329
330	typedef struct {
331	SCM val;
332	scm_t_uintmax min, max;
333	scm_t_uintmax result;
334	} to_unsigned_data;
335
336	static SCM
337	to_unsigned_integer_body (void *data)
338	{
339	to_unsigned_data d = (to_unsigned_data )data;
340	d->result = scm_to_unsigned_integer (d->val, d->min, d->max);
341	return SCM_BOOL_F;
342	}
343
344	static void
345	test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
346	scm_t_uintmax result, int range_error, int type_error)
347	{
348	to_unsigned_data data;
349	data.val = scm_c_eval_string (str);
350	data.min = min;
351	data.max = max;
352
353	if (range_error)
354	{
355	if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
356	to_unsigned_integer_body, &data,
357	out_of_range_handler, NULL)))
358	{
359	fprintf (stderr,
360	"fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> out of range\n",
361	str, min, max);
362	exit (1);
363	}
364	}
365	else if (type_error)
366	{
367	if (scm_is_false (scm_internal_catch (SCM_BOOL_T,
368	to_unsigned_integer_body, &data,
369	wrong_type_handler, NULL)))
370	{
371	fprintf (stderr,
372	"fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> wrong type\n",
373	str, min, max);
374	exit (1);
375	}
376	}
377	else
378	{
379	if (scm_is_true (scm_internal_catch (SCM_BOOL_T,
380	to_unsigned_integer_body, &data,
381	any_handler, NULL))
382	\|\| data.result != result)
383	{
384	fprintf (stderr,
385	"fail: scm_to_unsigned_int (%s, %Lu, %Lu) == %Lu\n",
386	str, min, max, result);
387	exit (1);
388	}
389	}
390	}
391
392	static void
393	test_to_unsigned_integer ()
394	{
395	test_4 ("'foo",
396	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
397	0, 0, 1);
398	test_4 ("3.5",
399	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
400	0, 0, 1);
401	test_4 ("12",
402	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
403	12, 0, 0);
404	test_4 ("1000",
405	0, 999,
406	0, 1, 0);
407	test_4 ("most-positive-fixnum",
408	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
409	SCM_MOST_POSITIVE_FIXNUM, 0, 0);
410	test_4 ("(+ most-positive-fixnum 1)",
411	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
412	SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
413	if (sizeof (scm_t_intmax) == 8)
414	{
415	test_4 ("(- (expt 2 64) 1)",
416	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
417	SCM_T_UINTMAX_MAX, 0, 0);
418	test_4 ("(expt 2 64)",
419	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
420	0, 1, 0);
421	}
422	else if (sizeof (scm_t_intmax) == 4)
423	{
424	test_4 ("(- (expt 2 32) 1)",
425	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
426	SCM_T_UINTMAX_MAX, 0, 0);
427	test_4 ("(expt 2 32)",
428	SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX,
429	0, 1, 0);
430	}
431	else
432	fprintf (stderr, "NOTE: skipped some tests.\n");
433	}
434
435	static void
436	test_5 (scm_t_intmax val, const char *result)
437	{
438	SCM res = scm_c_eval_string (result);
439	if (scm_is_false (scm_equal_p (scm_from_signed_integer (val), res)))
440	{
441	fprintf (stderr, "fail: scm_from_signed_integer (%Ld) == %s\n",
442	val, result);
443	exit (1);
444	}
445	}
446
447	static void
448	test_from_signed_integer ()
449	{
450	test_5 (12, "12");
451	if (sizeof (scm_t_intmax) == 8)
452	{
453	test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 63) 1)");
454	test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 63))");
455	}
456	else if (sizeof (scm_t_intmax) == 4)
457	{
458	test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 31) 1)");
459	test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 31))");
460	}
461	test_5 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
462	test_5 (SCM_MOST_NEGATIVE_FIXNUM, "most-negative-fixnum");
463	test_5 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
464	test_5 (SCM_MOST_NEGATIVE_FIXNUM-1, "(- most-negative-fixnum 1)");
465	}
466
467	static void
468	test_6 (scm_t_uintmax val, const char *result)
469	{
470	SCM res = scm_c_eval_string (result);
471	if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res)))
472	{
473	scm_write (scm_from_unsigned_integer (val), SCM_UNDEFINED);
474	scm_newline (SCM_UNDEFINED);
475	scm_write (res, SCM_UNDEFINED);
476	scm_newline (SCM_UNDEFINED);
477
478	fprintf (stderr, "fail: scm_from_unsigned_integer (%Lu) == %s\n",
479	val, result);
480	exit (1);
481	}
482	}
483
484	static void
485	test_from_unsigned_integer ()
486	{
487	test_6 (12, "12");
488	if (sizeof (scm_t_intmax) == 8)
489	{
490	test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 64) 1)");
491	}
492	else if (sizeof (scm_t_intmax) == 4)
493	{
494	test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 32) 1)");
495	}
496	test_6 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
497	test_6 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
498	}
499
500	int
501	main (int argc, char *argv[])
502	{
503	scm_init_guile();
504	test_is_signed_integer ();
505	test_is_unsigned_integer ();
506	test_to_signed_integer ();
507	test_to_unsigned_integer ();
508	test_from_signed_integer ();
509	test_from_unsigned_integer ();
510	return 0;
511	}