From 89992e62c1ebca854b1e95e75c0974c1b87d4d26 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Fri, 17 Aug 2018 14:59:09 +0300
Subject: [PATCH] * chicken.h: Fix C_u_fixnum_modulo by extracting the
 definition from C_fixnum_modulo

Signed-off-by: Peter Bex <address@hidden>
---
 chicken.h              | 15 ++++++++++-----
 tests/fixnum-tests.scm | 15 ++++++++++++++-
 tests/runtests.bat     |  4 ++++
 tests/runtests.sh      |  2 ++
 4 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/chicken.h b/chicken.h
index 4697560b..141ec2ee 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1164,7 +1164,6 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 #define C_u_fixnum_difference(n1, n2)   ((n1) - (n2) + C_FIXNUM_BIT)
 #define C_fixnum_difference(n1, n2)     (C_u_fixnum_difference(n1, n2) | C_FIXNUM_BIT)
 #define C_u_fixnum_divide(n1, n2)       (C_fix(C_unfix(n1) / C_unfix(n2)))
-#define C_u_fixnum_modulo(n1, n2)       (C_fix(C_unfix(n1) % C_unfix(n2)))
 #define C_u_fixnum_and(n1, n2)          ((n1) & (n2))
 #define C_fixnum_and(n1, n2)            (C_u_fixnum_and(n1, n2) | C_FIXNUM_BIT)
 #define C_u_fixnum_or(n1, n2)           ((n1) | (n2))
@@ -2835,15 +2834,21 @@ inline static C_word C_fixnum_divide(C_word x, C_word y)
 }
 
 
+inline static C_word C_u_fixnum_modulo(C_word x, C_word y)
+{
+  y = C_unfix(y);
+  x = C_unfix(x) % y;
+  if ((y < 0 && x > 0) || (y > 0 && x < 0)) x += y;
+  return C_fix(x);
+}
+
+
 inline static C_word C_fixnum_modulo(C_word x, C_word y)
 {
   if(y == C_fix(0)) {
     C_div_by_zero_error(C_text("fxmod"));
   } else {
-    y = C_unfix(y);
-    x = C_unfix(x) % y;
-    if ((y < 0 && x > 0) || (y > 0 && x < 0)) x += y;
-    return C_fix(x);
+    return C_u_fixnum_modulo(x,y);
   }
 }
 
diff --git a/tests/fixnum-tests.scm b/tests/fixnum-tests.scm
index 86e54d3a..fcd25265 100644
--- a/tests/fixnum-tests.scm
+++ b/tests/fixnum-tests.scm
@@ -1,8 +1,19 @@
-(import (chicken platform))
+(import (chicken platform)
+	(chicken fixnum))
 
 (define (fxo+ x y) (##core#inline "C_i_o_fixnum_plus" x y))
 (define (fxo- x y) (##core#inline "C_i_o_fixnum_difference" x y))
 
+(define-syntax assert
+  ;; compiling with -unsafe disables the original assert
+  (ir-macro-transformer
+   (lambda (e inj cmp)
+     (apply
+      (lambda (f)
+	`(if (not ,f)
+	     (error "assert" ',f)))
+      (cdr e)))))
+
 (assert (= 4 (fxo+ 2 2)))
 (assert (= -26 (fxo+ 74 -100)))
 (assert (= 1073741823 (fxo+ #x3ffffffe 1)))
@@ -21,3 +32,5 @@
  (if (feature? #:64bit)
      (not (fxo- (- #x3fffffffffffffff) 2))
      (not (fxo- (- #x3fffffff) 2))))
+
+(assert (= (modulo -3 4) (fxmod -3 4)))
diff --git a/tests/runtests.bat b/tests/runtests.bat
index e5cd60ae..5024889a 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -445,6 +445,10 @@ echo ======================================== fixnum tests ...
 if errorlevel 1 exit /b 1
 a.out
 if errorlevel 1 exit /b 1
+%compile% -unsafe fixnum-tests.scm
+if errorlevel 1 exit /b 1
+a.out
+if errorlevel 1 exit /b 1
 
 echo"======================================== random number tests ...
 %interpret% -s random-tests.scm
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 057df7c8..2c2e05a5 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -347,6 +347,8 @@ $interpret -s port-tests.scm
 echo "======================================== fixnum tests ..."
 $compile fixnum-tests.scm
 ./a.out
+$compile -unsafe fixnum-tests.scm
+./a.out
 
 echo "======================================== random number tests ..."
 $interpret -s random-tests.scm
-- 
2.11.0