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