[Guile-commits] branch main updated: Add missing branch in scm_is_less_than()

[Daniel Llorens]

This is an automated email from the git hooks/post-receive script.

lloda pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new 54c4753dd Add missing branch in scm_is_less_than()
54c4753dd is described below

commit 54c4753dd3f7506bee2778b36d7263b613ffd579
Author: Daniel Llorens <lloda@sarc.name>
AuthorDate: Mon Mar 18 13:53:17 2024 +0100

    Add missing branch in scm_is_less_than()
    
    Fixes https://debbugs.gnu.org/69725.
    
    * libguile/numbers.c (scm_is_less_than): Add branch for (< fraction real).
    * test-suite/tests/numbers.test (<): New test.
---
 libguile/numbers.c            | 17 ++++++++++++++---
 test-suite/tests/numbers.test | 27 +++++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 3 deletions(-)

diff --git a/libguile/numbers.c b/libguile/numbers.c
index 30a826f13..ae2aa7766 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -4559,6 +4559,7 @@ scm_is_less_than (SCM x, SCM y)
        return SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y);
       if (!SCM_FRACTIONP (y))
         abort ();
+      /* REALP x FRACTIONP y, see symmetric case below  */
       if (isnan (SCM_REAL_VALUE (x)))
         return 0;
       if (isinf (SCM_REAL_VALUE (x)))
@@ -4569,9 +4570,19 @@ scm_is_less_than (SCM x, SCM y)
   if (!SCM_FRACTIONP (x))
     abort ();
 
-  /* "a/b < " becomes "a < y*b" */
-  return scm_is_less_than (SCM_FRACTION_NUMERATOR (x),
-                           scm_product (y, SCM_FRACTION_DENOMINATOR (x)));
+  if (SCM_REALP (y))
+    {
+      /* FRACTIONP x REALP y, see symmetric case above */
+      if (isnan (SCM_REAL_VALUE (y)))
+        return 0;
+      if (isinf (SCM_REAL_VALUE (y)))
+        return 0.0 < SCM_REAL_VALUE (y);
+      return scm_is_less_than (x, scm_inexact_to_exact (y));
+    }
+  else
+    /* "a/b < y" becomes "a < y*b" */
+    return scm_is_less_than (SCM_FRACTION_NUMERATOR (x),
+                             scm_product (y, SCM_FRACTION_DENOMINATOR (x)));
 }
 
 static int
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 0b80c0356..a5e993135 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -266,6 +266,33 @@
     (pass-if (not (exact? -inf.0)))
     (pass-if (not (exact? +nan.0)))))
 
+;;;
+;;; <
+;;;
+
+(with-test-prefix "bug #69725 for (< fraction float)"
+
+  (let ((diff 
879797032764096269186597679847100265884832692381817056132294700511440987615745549195576394246327599597660137250885282118923685378363495296576250891618672897887455888641129758660040580125471657527501887655846743402333407472717488972378318312674085710204045036645651022493812366478520603176717119923372376049351273979050815421434638458049196631010462508376132028146644267658632127872001/722822868417972349291869843452690786425750906620439512189327802121058061301404726887882493296
 [...]
+    ;; ^ 1.217168231948292
+
+    (pass-if "< fraction float (1)"
+      (not (< diff 1.0)))
+    (pass-if "< fraction float (2)"
+      (< diff 2.0))
+    (pass-if "< fraction float (3)"
+      (< diff +inf.0))
+    (pass-if "< fraction float (4)"
+      (not (< diff -inf.0)))
+    
+    (pass-if "< float fraction (1)"
+      (< 1.0 diff))
+    (pass-if "< float fraction (2)"
+      (not (< 2.0 diff)))
+    (pass-if "< float fraction (3)"
+      (not (< +inf.0 diff)))
+    (pass-if "< float fraction (4)"
+      (< -inf.0 diff))))
+
 ;;;
 ;;; exp
 ;;;