* num2integral long long range check
@ 2004-04-24 21:30 Kevin Ryde
0 siblings, 0 replies; only message in thread
From: Kevin Ryde @ 2004-04-24 21:30 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 416 bytes --]
Some gremlins in the range checking of scm_num2long_long,
* num2integral.i.c (NUM2INTEGRAL): Under non-BIGMPZ_FITSP case,
corrections to range check for signed numbers.
* standalone/test-num2integral.c (test_long_long): Exercise
out-of-range errors on various cases.
(test_ulong_long): New function, split from test_long_long and
similarly exercising out-of-range.
[-- Attachment #2: num2integral.i.c.range.diff --]
[-- Type: text/plain, Size: 2084 bytes --]
--- num2integral.i.c.~1.21.~ 2004-02-14 13:23:30.000000000 +1000
+++ num2integral.i.c 2004-04-24 15:54:15.000000000 +1000
@@ -88,19 +88,44 @@
}
else
{
+ size_t itype_bits = sizeof (ITYPE) * SCM_CHAR_BIT;
+ int sgn = mpz_sgn (SCM_I_BIG_MPZ (num));
size_t numbits;
+
if (UNSIGNED)
{
- int sgn = mpz_sgn (SCM_I_BIG_MPZ (num));
- scm_remember_upto_here_1 (num);
if (sgn < 0)
scm_out_of_range (s_caller, num);
}
-
+
numbits = mpz_sizeinbase (SCM_I_BIG_MPZ (num), 2);
- scm_remember_upto_here_1 (num);
- if (numbits > (sizeof (ITYPE) * SCM_CHAR_BIT))
- scm_out_of_range (s_caller, num);
+
+ if (UNSIGNED)
+ {
+ if (numbits > itype_bits)
+ scm_out_of_range (s_caller, num);
+ }
+ else
+ {
+ if (sgn >= 0)
+ {
+ /* positive, require num < 2^(itype_bits-1) */
+ if (numbits > itype_bits-1)
+ scm_out_of_range (s_caller, num);
+ }
+ else
+ {
+ /* negative, require abs(num) < 2^(itype_bits-1), but
+ also allow num == -2^(itype_bits-1), the latter
+ detected by numbits==itype_bits plus the lowest
+ (and only) 1 bit at position itype_bits-1 */
+ if (numbits > itype_bits
+ || (numbits == itype_bits
+ && (mpz_scan1 (SCM_I_BIG_MPZ (num), 0)
+ != itype_bits - 1)))
+ scm_out_of_range (s_caller, num);
+ }
+ }
}
if (UNSIGNED && (SIZEOF_ITYPE <= SIZEOF_UNSIGNED_LONG))
[-- Attachment #3: test-num2integral.c.range.diff --]
[-- Type: text/plain, Size: 4020 bytes --]
--- test-num2integral.c.~1.1.~ 2003-04-08 03:48:31.000000000 +1000
+++ test-num2integral.c 2004-04-24 15:59:13.000000000 +1000
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001,2003 Free Software Foundation, Inc.
+/* 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
@@ -29,6 +29,33 @@
# endif
#endif
+
+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_equal_p (key, scm_str2symbol ("out-of-range")));
+ return SCM_BOOL_T;
+}
+
+SCM
+call_num2long_long_body (void *data)
+{
+ scm_num2long_long (* (SCM *) data, SCM_ARG1, "call_num2long_long_body");
+ return SCM_BOOL_F;
+}
+
+SCM
+call_num2ulong_long_body (void *data)
+{
+ scm_num2ulong_long (* (SCM *) data, SCM_ARG1, "call_num2ulong_long_body");
+ return SCM_BOOL_F;
+}
+
static void
test_long_long ()
{
@@ -38,11 +65,87 @@
long long result = scm_num2long_long(n, 0, "main");
assert (result == LLONG_MIN);
}
+
+ /* LLONG_MIN - 1 */
+ {
+ SCM n = scm_difference (scm_long_long2num (LLONG_MIN), SCM_MAKINUM(1));
+ SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
+ out_of_range_handler, NULL);
+ assert (! SCM_FALSEP (caught));
+ }
+
+ /* LLONG_MIN + LLONG_MIN/2 */
+ {
+ SCM n = scm_sum (scm_long_long2num (LLONG_MIN),
+ scm_long_long2num (LLONG_MIN / 2));
+ SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
+ out_of_range_handler, NULL);
+ assert (! SCM_FALSEP (caught));
+ }
+
+ /* LLONG_MAX + 1 */
+ {
+ SCM n = scm_sum (scm_long_long2num (LLONG_MAX), SCM_MAKINUM(1));
+ SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
+ out_of_range_handler, NULL);
+ assert (! SCM_FALSEP (caught));
+ }
+
+ /* 2^1024 */
+ {
+ SCM n = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024));
+ SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
+ out_of_range_handler, NULL);
+ assert (! SCM_FALSEP (caught));
+ }
+
+ /* -2^1024 */
+ {
+ SCM n = scm_difference (SCM_MAKINUM (0),
+ scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024)));
+ SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
+ out_of_range_handler, NULL);
+ assert (! SCM_FALSEP (caught));
+ }
+
+#endif /* SCM_SIZEOF_LONG_LONG != 0 */
+}
+
+static void
+test_ulong_long ()
+{
+#if SCM_SIZEOF_LONG_LONG != 0
+
{
SCM n = scm_ulong_long2num (ULLONG_MAX);
unsigned long long result = scm_num2ulong_long(n, 0, "main");
assert (result == ULLONG_MAX);
}
+
+ /* -1 */
+ {
+ SCM n = SCM_MAKINUM (-1);
+ SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n,
+ out_of_range_handler, NULL);
+ assert (! SCM_FALSEP (caught));
+ }
+
+ /* ULLONG_MAX + 1 */
+ {
+ SCM n = scm_sum (scm_ulong_long2num (ULLONG_MAX), SCM_MAKINUM(1));
+ SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n,
+ out_of_range_handler, NULL);
+ assert (! SCM_FALSEP (caught));
+ }
+
+ /* 2^1024 */
+ {
+ SCM n = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024));
+ SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
+ out_of_range_handler, NULL);
+ assert (! SCM_FALSEP (caught));
+ }
+
#endif /* SCM_SIZEOF_LONG_LONG != 0 */
}
@@ -51,5 +154,6 @@
{
scm_init_guile();
test_long_long ();
+ test_ulong_long ();
return 0;
}
[-- Attachment #4: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2004-04-24 21:30 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2004-04-24 21:30 num2integral long long range check Kevin Ryde
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).