123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157 |
- /* Copyright 1999-2001,2003-2004,2006,2008,2010-2012,2014,2018
- 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/>. */
- #ifdef HAVE_CONFIG_H
- # include <config.h>
- #endif
- #undef NDEBUG
- #include <libguile.h>
- #include <stdio.h>
- #include <assert.h>
- #include <limits.h>
- 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)
- {
- assert (scm_is_eq (key, scm_from_locale_symbol ("out-of-range")));
- return SCM_BOOL_T;
- }
- SCM
- call_num2long_long_body (void *data)
- {
- scm_to_long_long (* (SCM *) data);
- return SCM_BOOL_F;
- }
- SCM
- call_num2ulong_long_body (void *data)
- {
- scm_to_ulong_long (* (SCM *) data);
- return SCM_BOOL_F;
- }
- static void
- test_long_long ()
- {
- {
- SCM n = scm_from_long_long (LLONG_MIN);
- long long result = scm_to_long_long(n);
- assert (result == LLONG_MIN);
- }
- /* LLONG_MIN - 1 */
- {
- SCM n = scm_difference (scm_from_long_long (LLONG_MIN), scm_from_int (1));
- SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
- out_of_range_handler, NULL);
- assert (scm_is_true (caught));
- }
- /* SCM_I_LLONG_MIN + SCM_I_LLONG_MIN/2 */
- {
- SCM n = scm_sum (scm_from_long_long (LLONG_MIN),
- scm_from_long_long (LLONG_MIN / 2));
- SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
- out_of_range_handler, NULL);
- assert (scm_is_true (caught));
- }
- /* SCM_I_LLONG_MAX + 1 */
- {
- SCM n = scm_sum (scm_from_long_long (LLONG_MAX), scm_from_int (1));
- SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
- out_of_range_handler, NULL);
- assert (scm_is_true (caught));
- }
- /* 2^1024 */
- {
- SCM n = scm_ash (scm_from_int (1), scm_from_int (1024));
- SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
- out_of_range_handler, NULL);
- assert (scm_is_true (caught));
- }
- /* -2^1024 */
- {
- SCM n = scm_difference (scm_from_int (0),
- scm_ash (scm_from_int (1), scm_from_int (1024)));
- SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
- out_of_range_handler, NULL);
- assert (scm_is_true (caught));
- }
- }
- static void
- test_ulong_long ()
- {
- {
- SCM n = scm_from_ulong_long (ULLONG_MAX);
- unsigned long long result = scm_to_ulong_long(n);
- assert (result == ULLONG_MAX);
- }
- /* -1 */
- {
- SCM n = scm_from_int (-1);
- SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n,
- out_of_range_handler, NULL);
- assert (scm_is_true (caught));
- }
- /* SCM_I_ULLONG_MAX + 1 */
- {
- SCM n = scm_sum (scm_from_ulong_long (ULLONG_MAX), scm_from_int (1));
- SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n,
- out_of_range_handler, NULL);
- assert (scm_is_true (caught));
- }
- /* 2^1024 */
- {
- SCM n = scm_ash (scm_from_int (1), scm_from_int (1024));
- SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
- out_of_range_handler, NULL);
- assert (scm_is_true (caught));
- }
- }
- static void
- tests (void *data, int argc, char **argv)
- {
- test_long_long ();
- test_ulong_long ();
- }
- int
- main (int argc, char *argv[])
- {
- scm_boot_guile (argc, argv, tests, NULL);
- return 0;
- }
|