From b10586f098fd7d0303bc605de35af1ec4da68a29 Mon Sep 17 00:00:00 2001
From: Michael Livshin <mlivshin@bigfoot.com>
Date: Sat, 1 Sep 2001 17:17:50 +0000
Subject: [PATCH] * 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!
---
 libguile/ChangeLog        |  9 ++++++++
 libguile/num2integral.i.c |  8 ++++---
 libguile/numbers.c        | 46 +++++++++++++++++++++++++++++++++++++++
 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