~ chicken-core (chicken-5) f07a5670e230d5e8630567c90ebddf6597998a06

commit f07a5670e230d5e8630567c90ebddf6597998a06
Author:     megane <meganeka@gmail.com>
AuthorDate: Fri Aug 17 14:59:09 2018 +0300
Commit:     Kooda <kooda@upyum.com>
CommitDate: Mon Aug 27 21:50:19 2018 +0200

    * chicken.h: Fix C_u_fixnum_modulo by extracting the definition from C_fixnum_modulo
    
    Signed-off-by: Peter Bex <peter@more-magic.net>
    Signed-off-by: Kooda <kooda@upyum.com>

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