From 82d61b3d8e50bacc266b450e21127663f3c39de5 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Sat, 12 Feb 2022 07:50:58 +0900
Subject: [PATCH] make mixed inexact/exact ordering consistent, converting to
 exact for fixnums and ratios instead of just bignums (issue #812)

---
 bignum.c             | 14 +++++++-------
 tests/r7rs-tests.scm |  1 +
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/bignum.c b/bignum.c
index 93a765f5..097aced1 100644
--- a/bignum.c
+++ b/bignum.c
@@ -1886,12 +1886,13 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
       r = sexp_make_fixnum(sexp_unbox_fixnum(a) - sexp_unbox_fixnum(b));
       break;
     case SEXP_NUM_FIX_FLO:
-      f = sexp_fixnum_to_double(a);
-      g = sexp_flonum_value(b);
-      if (isnan(g))
+      if (isinf(sexp_flonum_value(b))) {
+        r = sexp_flonum_value(b) > 0 ? SEXP_NEG_ONE : SEXP_ONE;
+      } else if (isnan(sexp_flonum_value(b))) {
         r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", b);
-      else
-        r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
+      } else {
+        r = sexp_compare(ctx, a, tmp=sexp_inexact_to_exact(ctx, NULL, 1, b));
+      }
       break;
     case SEXP_NUM_FIX_BIG:
       if ((sexp_bignum_hi(b) > 1) ||
@@ -1933,8 +1934,7 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
       } else if (isnan(f)) {
         r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", a);
       } else {
-        g = sexp_ratio_to_double(ctx, b);
-        r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
+        r = sexp_compare(ctx, tmp=sexp_inexact_to_exact(ctx, NULL, 1, a), b);
       }
       break;
     case SEXP_NUM_FIX_RAT:
diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm
index cb344aa3..602fc5c4 100644
--- a/tests/r7rs-tests.scm
+++ b/tests/r7rs-tests.scm
@@ -798,6 +798,7 @@
 (test #f (< +nan.0 0.0))
 (test #f (> +nan.0 0.0))
 (test '(#t #f) (list (<= 1 1 2) (<= 2 1 3)))
+(test #f (= 9007199254740992.0 9007199254740993))
 
 ;; From R7RS 6.2.6 Numerical operations:
 ;;