mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Add missing branch in scm_is_less_than()

Browse source 
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.
This commit is contained in:
Daniel Llorens 2024-03-18 13:53:17 +01:00
parent 2c645571b3
commit 54c4753dd3
2 changed files with 41 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

17
libguile/numbers.c
View file

@ -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

27
test-suite/tests/numbers.test
View file

@ -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
;;;