2018-06-20 19:17:06 +02:00
|
|
|
/* Copyright 1999-2001,2003-2004,2006,2008,2010-2012,2014,2018
|
2018-06-20 20:01:49 +02:00
|
|
|
Free Software Foundation, Inc.
|
|
|
|
|
|
|
|
|
|
This file is part of Guile.
|
|
|
|
|
|
|
|
|
|
Guile 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 3 of the License, or
|
|
|
|
|
(at your option) any later version.
|
|
|
|
|
|
|
|
|
|
Guile 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 Guile. If not, see
|
|
|
|
|
<https://www.gnu.org/licenses/>. */
|
2003-04-07 17:48:31 +00:00
|
|
|
|
2011-04-25 23:54:47 +02:00
|
|
|
#ifdef HAVE_CONFIG_H
|
2008-09-13 20:09:08 +02:00
|
|
|
# include <config.h>
|
|
|
|
|
#endif
|
|
|
|
|
|
2014-03-20 09:43:01 +01:00
|
|
|
#undef NDEBUG
|
|
|
|
|
|
2008-04-06 18:41:07 +02:00
|
|
|
#include <libguile.h>
|
2003-04-07 17:48:31 +00:00
|
|
|
|
|
|
|
|
#include <stdio.h>
|
|
|
|
|
#include <assert.h>
|
2011-05-15 11:27:52 +02:00
|
|
|
#include <limits.h>
|
2003-04-07 17:48:31 +00:00
|
|
|
|
2004-04-27 23:19:35 +00:00
|
|
|
SCM out_of_range_handler (void *data, SCM key, SCM args);
|
|
|
|
|
SCM call_num2long_long_body (void *data);
|
|
|
|
|
SCM call_num2ulong_long_body (void *data);
|
|
|
|
|
|
|
|
|
|
/* expect to catch an `out-of-range' exception */
|
|
|
|
|
SCM
|
|
|
|
|
out_of_range_handler (void *data, SCM key, SCM args)
|
|
|
|
|
{
|
2012-01-08 16:08:45 +01:00
|
|
|
assert (scm_is_eq (key, scm_from_locale_symbol ("out-of-range")));
|
2004-04-27 23:19:35 +00:00
|
|
|
return SCM_BOOL_T;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
SCM
|
|
|
|
|
call_num2long_long_body (void *data)
|
|
|
|
|
{
|
2010-08-08 13:43:40 +02:00
|
|
|
scm_to_long_long (* (SCM *) data);
|
2004-04-27 23:19:35 +00:00
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
SCM
|
|
|
|
|
call_num2ulong_long_body (void *data)
|
|
|
|
|
{
|
2010-08-08 13:43:40 +02:00
|
|
|
scm_to_ulong_long (* (SCM *) data);
|
2004-04-27 23:19:35 +00:00
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
}
|
|
|
|
|
|
2003-04-07 17:48:31 +00:00
|
|
|
static void
|
|
|
|
|
test_long_long ()
|
|
|
|
|
{
|
|
|
|
|
{
|
2011-05-15 11:27:52 +02:00
|
|
|
SCM n = scm_from_long_long (LLONG_MIN);
|
2010-08-08 13:43:40 +02:00
|
|
|
long long result = scm_to_long_long(n);
|
2011-05-15 11:27:52 +02:00
|
|
|
assert (result == LLONG_MIN);
|
2003-04-07 17:48:31 +00:00
|
|
|
}
|
2004-04-27 23:19:35 +00:00
|
|
|
|
|
|
|
|
/* LLONG_MIN - 1 */
|
|
|
|
|
{
|
2011-05-15 11:27:52 +02:00
|
|
|
SCM n = scm_difference (scm_from_long_long (LLONG_MIN), scm_from_int (1));
|
2004-04-27 23:19:35 +00:00
|
|
|
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
|
|
|
|
|
out_of_range_handler, NULL);
|
2004-07-06 13:19:42 +00:00
|
|
|
assert (scm_is_true (caught));
|
2004-04-27 23:19:35 +00:00
|
|
|
}
|
|
|
|
|
|
2004-07-08 16:01:02 +00:00
|
|
|
/* SCM_I_LLONG_MIN + SCM_I_LLONG_MIN/2 */
|
2004-04-27 23:19:35 +00:00
|
|
|
{
|
2011-05-15 11:27:52 +02:00
|
|
|
SCM n = scm_sum (scm_from_long_long (LLONG_MIN),
|
|
|
|
|
scm_from_long_long (LLONG_MIN / 2));
|
2004-04-27 23:19:35 +00:00
|
|
|
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
|
|
|
|
|
out_of_range_handler, NULL);
|
2004-07-06 13:19:42 +00:00
|
|
|
assert (scm_is_true (caught));
|
2004-04-27 23:19:35 +00:00
|
|
|
}
|
|
|
|
|
|
2004-07-08 16:01:02 +00:00
|
|
|
/* SCM_I_LLONG_MAX + 1 */
|
2004-04-27 23:19:35 +00:00
|
|
|
{
|
2011-05-15 11:27:52 +02:00
|
|
|
SCM n = scm_sum (scm_from_long_long (LLONG_MAX), scm_from_int (1));
|
2004-04-27 23:19:35 +00:00
|
|
|
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
|
|
|
|
|
out_of_range_handler, NULL);
|
2004-07-06 13:19:42 +00:00
|
|
|
assert (scm_is_true (caught));
|
2004-04-27 23:19:35 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* 2^1024 */
|
|
|
|
|
{
|
2004-07-08 16:01:02 +00:00
|
|
|
SCM n = scm_ash (scm_from_int (1), scm_from_int (1024));
|
2004-04-27 23:19:35 +00:00
|
|
|
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
|
|
|
|
|
out_of_range_handler, NULL);
|
2004-07-06 13:19:42 +00:00
|
|
|
assert (scm_is_true (caught));
|
2004-04-27 23:19:35 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* -2^1024 */
|
|
|
|
|
{
|
2004-07-08 16:01:02 +00:00
|
|
|
SCM n = scm_difference (scm_from_int (0),
|
|
|
|
|
scm_ash (scm_from_int (1), scm_from_int (1024)));
|
2004-04-27 23:19:35 +00:00
|
|
|
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
|
|
|
|
|
out_of_range_handler, NULL);
|
2004-07-06 13:19:42 +00:00
|
|
|
assert (scm_is_true (caught));
|
2004-04-27 23:19:35 +00:00
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
static void
|
|
|
|
|
test_ulong_long ()
|
|
|
|
|
{
|
2003-04-07 17:48:31 +00:00
|
|
|
{
|
2011-05-15 11:27:52 +02:00
|
|
|
SCM n = scm_from_ulong_long (ULLONG_MAX);
|
2010-08-08 13:43:40 +02:00
|
|
|
unsigned long long result = scm_to_ulong_long(n);
|
2011-05-15 11:27:52 +02:00
|
|
|
assert (result == ULLONG_MAX);
|
2003-04-07 17:48:31 +00:00
|
|
|
}
|
2004-04-27 23:19:35 +00:00
|
|
|
|
|
|
|
|
/* -1 */
|
|
|
|
|
{
|
2004-07-08 16:01:02 +00:00
|
|
|
SCM n = scm_from_int (-1);
|
2004-04-27 23:19:35 +00:00
|
|
|
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n,
|
|
|
|
|
out_of_range_handler, NULL);
|
2004-07-06 13:19:42 +00:00
|
|
|
assert (scm_is_true (caught));
|
2004-04-27 23:19:35 +00:00
|
|
|
}
|
|
|
|
|
|
2004-07-08 16:01:02 +00:00
|
|
|
/* SCM_I_ULLONG_MAX + 1 */
|
2004-04-27 23:19:35 +00:00
|
|
|
{
|
2011-05-15 11:27:52 +02:00
|
|
|
SCM n = scm_sum (scm_from_ulong_long (ULLONG_MAX), scm_from_int (1));
|
2004-04-27 23:19:35 +00:00
|
|
|
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n,
|
|
|
|
|
out_of_range_handler, NULL);
|
2004-07-06 13:19:42 +00:00
|
|
|
assert (scm_is_true (caught));
|
2004-04-27 23:19:35 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* 2^1024 */
|
|
|
|
|
{
|
2004-07-08 16:01:02 +00:00
|
|
|
SCM n = scm_ash (scm_from_int (1), scm_from_int (1024));
|
2004-04-27 23:19:35 +00:00
|
|
|
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
|
|
|
|
|
out_of_range_handler, NULL);
|
2004-07-06 13:19:42 +00:00
|
|
|
assert (scm_is_true (caught));
|
2004-04-27 23:19:35 +00:00
|
|
|
}
|
2003-04-07 17:48:31 +00:00
|
|
|
}
|
|
|
|
|
|
2006-10-09 23:40:48 +00:00
|
|
|
static void
|
|
|
|
|
tests (void *data, int argc, char **argv)
|
2003-04-07 17:48:31 +00:00
|
|
|
{
|
|
|
|
|
test_long_long ();
|
2004-04-27 23:19:35 +00:00
|
|
|
test_ulong_long ();
|
2006-10-09 23:40:48 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
|
main (int argc, char *argv[])
|
|
|
|
|
{
|
|
|
|
|
scm_boot_guile (argc, argv, tests, NULL);
|
2003-04-07 17:48:31 +00:00
|
|
|
return 0;
|
|
|
|
|
}
|