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/722822868417972349291869843452690786425750906620439512189327802121058061301404726887882493296646015935903482610570303382076049858386583955490031061870416075735232078523284307346352926571709615036536557063178291059619363366958123014280624087029240670600236519573317406921775499062373875623452948086789385672089163532498692518546438923870180903091519351584154949372291968970659168272384)) + ;; ^ 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 ;;;