summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog9
-rw-r--r--libguile/num2integral.i.c8
-rw-r--r--libguile/numbers.c46
3 files changed, 60 insertions, 3 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index b886a422f..4bbc49584 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,12 @@
+2001-09-01 Michael Livshin <mlivshin@bigfoot.com>
+
+ * numbers.c (scm_sys_check_number_conversions): new function,
+ defined if Guile is compiled in debugging mode. currently checks
+ `scm_num2ulong', should check much much more.
+
+ * num2integral.i.c (NUM2INTEGRAL): when converting a bignum to
+ unsigned, ensure that it's positive. thanks to Martin Baulig!
+
2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de>
* __scm.h: Added new section about compile time selectable
diff --git a/libguile/num2integral.i.c b/libguile/num2integral.i.c
index e0982bac3..65afa2603 100644
--- a/libguile/num2integral.i.c
+++ b/libguile/num2integral.i.c
@@ -47,8 +47,10 @@ NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
res = new;
}
-#ifndef UNSIGNED
if (SCM_BIGSIGN (num))
+#ifdef UNSIGNED
+ scm_out_of_range (s_caller, num);
+#else
{
res = -res;
if (res <= 0)
@@ -56,6 +58,7 @@ NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
else
scm_out_of_range (s_caller, num);
}
+#endif
else
{
if (res >= 0)
@@ -63,8 +66,7 @@ NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
else
scm_out_of_range (s_caller, num);
}
-#endif
-
+
return res;
}
else if (SCM_REALP (num))
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 3bead8ce6..266d09932 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -4407,6 +4407,52 @@ check_sanity ()
#endif
}
+#undef CHECK
+
+#define CHECK \
+ scm_internal_catch (SCM_BOOL_T, check_body, &data, check_handler, &data); \
+ if (!SCM_FALSEP (data)) abort();
+
+static SCM
+check_body (void *data)
+{
+ SCM num = *(SCM *) data;
+ scm_num2ulong (num, 1, NULL);
+
+ return SCM_UNSPECIFIED;
+}
+
+static SCM
+check_handler (void *data, SCM tag, SCM throw_args)
+{
+ SCM *num = (SCM *) data;
+ *num = SCM_BOOL_F;
+
+ return SCM_UNSPECIFIED;
+}
+
+SCM_DEFINE (scm_sys_check_number_conversions, "%check-number-conversions", 0, 0, 0,
+ (),
+ "Number conversion sanity checking.")
+#define FUNC_NAME s_scm_sys_check_number_conversions
+{
+ SCM data = SCM_MAKINUM (-1);
+ CHECK;
+ data = scm_int2num (INT_MIN);
+ CHECK;
+ data = scm_ulong2num (ULONG_MAX);
+ data = scm_difference (SCM_INUM0, data);
+ CHECK;
+ data = scm_ulong2num (ULONG_MAX);
+ data = scm_sum (SCM_MAKINUM (1), data); data = scm_difference (SCM_INUM0, data);
+ CHECK;
+ data = scm_int2num (-10000); data = scm_product (data, data); data = scm_product (data, data);
+ CHECK;
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
#endif
void