make perl core quiet under -Wfloat-equal

The gcc option -Wfloat-equal warns when two floating-point numbers
are directly compared for equality or inequality, the idea being that
this is usually a logic error, and that you should be checking that the
values are instead very near to each other.

perl on the other hand has lots of reasons to do a direct comparison.

Add two macros, NV_eq_nowarn(a,b) and NV_eq_nowarn(a,b)
that do the same as (a == b) and (a != b), but without the warnings.
They achieve this by instead doing (a < b) || ( a > b).
Under gcc at least, this is optimised into the same code as the direct
comparison.

The are three places that I've left untouched, because they are handling
NaNs, and that gets a bit tricky. In particular (nv != nv) is a test for a
NaN, and replacing it with (< || >) creates signalling NaNs (whereas ==
and != create quiet NaNs)

diff --git a/dump.c b/dump.c
index 409b975..2ec4eba 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -475,7 +475,7 @@ Perl_sv_peek(pTHX_ SV *sv)
                !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
                                  SVp_POK|SVp_NOK)) &&
                SvCUR(sv) == 0 &&
-               SvNVX(sv) == 0.0)
+               NV_eq_nowarn(SvNVX(sv), 0.0))
                goto finish;
        }
        else if (sv == &PL_sv_yes) {
@@ -486,7 +486,7 @@ Perl_sv_peek(pTHX_ SV *sv)
                                  SVp_POK|SVp_NOK)) &&
                SvCUR(sv) == 1 &&
                SvPVX_const(sv) && *SvPVX_const(sv) == '1' &&
-               SvNVX(sv) == 1.0)
+               NV_eq_nowarn(SvNVX(sv), 1.0))
                goto finish;
        }
        else {

diff --git a/numeric.c b/numeric.c
index 37f7026..3ad5af7 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -780,8 +780,8 @@ S_mulexp10(NV value, I32 exponent)
 
     if (exponent == 0)
        return value;
-    if (value == 0)
-       return (NV)0;
+    if (NV_eq_nowarn(value, 0.0))
+       return (NV)0.0;
 
     /* On OpenVMS VAX we by default use the D_FLOAT double format,
      * and that format does not have *easy* capabilities [1] for

diff --git a/op.c b/op.c
index d9d1f8c..47c24d7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1533,7 +1533,8 @@ Perl_scalarvoid(pTHX_ OP *o)
                /* the constants 0 and 1 are permitted as they are
                   conventionally used as dummies in constructs like
                        1 while some_condition_with_side_effects;  */
-               else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
+               else if (SvNIOK(sv) && (NV_eq_nowarn(SvNV(sv), 0.0) ||
+                                        NV_eq_nowarn(SvNV(sv), 1.0)))
                    useless = NULL;
                else if (SvPOK(sv)) {
                     SV * const dsv = newSVpvs("");

diff --git a/perl.h b/perl.h
index dc140bd..287ded8 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -474,6 +474,16 @@
 #undef  ASCIIish
 #endif
 
+
+/* with gcc -Wfloat-equal, the test (nv == 0.0) generates an 'unsafe'
+ * warning. This disable the warning on the odd occasion we need to
+ * compare to a fixed value.  On gcc at least, the double comparison is
+ * optimised back to a simple ==.
+ */
+#define NV_ne_nowarn(a,b) ((a) < (b) || (a) > (b))
+#define NV_eq_nowarn(a,b) (!NV_ne_nowarn(a,b))
+
+
 /*
  * The following contortions are brought to you on behalf of all the
  * standards, semi-standards, de facto standards, not-so-de-facto standards

diff --git a/pp.c b/pp.c
index a6ab24d..3b55e66 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1492,7 +1492,7 @@ PP(pp_divide)
 #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
        if (! Perl_isnan(right) && right == 0.0)
 #else
-       if (right == 0.0)
+       if (NV_eq_nowarn(right, 0.0))
 #endif
            DIE(aTHX_ "Illegal division by zero");
        PUSHn( left / right );
@@ -1592,11 +1592,11 @@ PP(pp_modulo)
        if (use_double) {
            NV dans;
 
-           if (!dright)
+           if (NV_eq_nowarn(dright, 0.0))
                DIE(aTHX_ "Illegal modulus zero");
 
            dans = Perl_fmod(dleft, dright);
-           if ((left_neg != right_neg) && dans)
+           if ((left_neg != right_neg) && NV_ne_nowarn(dans, 0.0))
                dans = dright - dans;
            if (right_neg)
                dans = -dans;
@@ -2072,7 +2072,7 @@ Perl_do_ncmp(pTHX_ SV* const left, SV * const right)
        return -1;
       if (lnv > rnv)
        return 1;
-      if (lnv == rnv)
+      if (NV_eq_nowarn(lnv, rnv))
        return 0;
       return 2;
 #endif
@@ -2746,7 +2746,7 @@ PP(pp_rand)
                value = SvNV(sv);
        }
     /* 1 of 2 things can be carried through SvNV, SP or TARG, SP was carried */
-       if (value == 0.0)
+       if (NV_eq_nowarn(value, 0.0))
            value = 1.0;
        {
            dTARGET;

diff --git a/pp_sort.c b/pp_sort.c
index c8fe08e..bac92f9 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1931,7 +1931,7 @@ S_sv_i_ncmp(pTHX_ SV *const a, SV *const b)
        ? amagic_call(left, right, meth, 0) \
        : NULL;
 
-#define SORT_NORMAL_RETURN_VALUE(val)  (((val) > 0) ? 1 : ((val) ? -1 : 0))
+#define SORT_NORMAL_RETURN_VALUE(val)  (((val) > 0) ? 1 : ((val < 0) ? -1 : 0))
 
 static I32
 S_amagic_ncmp(pTHX_ SV *const a, SV *const b)

diff --git a/pp_sys.c b/pp_sys.c
index 78308f4..92d4c60 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4466,7 +4466,7 @@ PP(pp_gmtime)
     else {
        NV input = Perl_floor(POPn);
        when = (Time64_T)input;
-       if (when != input) {
+       if (NV_ne_nowarn(when, input)) {
            /* diag_listed_as: gmtime(%f) too large */
            Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                           "%s(%.0" NVff ") too large", opname, input);

diff --git a/sv.c b/sv.c
index bbb2a03..06ef9ed 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1982,7 +1982,7 @@ S_sv_2iuv_non_preserve(pTHX_ SV *const sv
        sv_2iv  */
     if (SvNVX(sv) <= (UV)IV_MAX) {
         SvIV_set(sv, I_V(SvNVX(sv)));
-        if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
+        if (NV_eq_nowarn((NV)(SvIVX(sv)), SvNVX(sv))) {
             SvIOK_on(sv); /* Integer is precise. NOK, IOK */
         } else {
             /* Integer is imprecise. NOK, IOKp */
@@ -1991,7 +1991,7 @@ S_sv_2iuv_non_preserve(pTHX_ SV *const sv
     }
     SvIsUV_on(sv);
     SvUV_set(sv, U_V(SvNVX(sv)));
-    if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
+    if (NV_eq_nowarn((NV)(SvUVX(sv)), SvNVX(sv))) {
         if (SvUVX(sv) == UV_MAX) {
             /* As we know that NVs don't preserve UVs, UV_MAX cannot
                possibly be preserved by NV. Hence, it must be overflow.
@@ -2037,7 +2037,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
 #endif
        if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
            SvIV_set(sv, I_V(SvNVX(sv)));
-           if (SvNVX(sv) == (NV) SvIVX(sv)
+           if (NV_eq_nowarn(SvNVX(sv), (NV)SvIVX(sv))
 #ifndef NV_PRESERVES_UV
                && (((UV)1 << NV_PRESERVES_UV_BITS) >
                    (UV)(SvIVX(sv) > 0 ? SvIVX(sv) : -SvIVX(sv)))
@@ -2080,7 +2080,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
        else {
            SvUV_set(sv, U_V(SvNVX(sv)));
            if (
-               (SvNVX(sv) == (NV) SvUVX(sv))
+               (NV_eq_nowarn(SvNVX(sv), (NV) SvUVX(sv)))
 #ifndef  NV_PRESERVES_UV
                /* Make sure it's not 0xFFFFFFFFFFFFFFFF */
                /*&& (SvUVX(sv) != UV_MAX) irrelevant with code below */
@@ -2226,7 +2226,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
                     (void)SvIOKp_on(sv);
                     SvNOK_on(sv);
                     SvIV_set(sv, I_V(SvNVX(sv)));
-                    if ((NV)(SvIVX(sv)) == SvNVX(sv))
+                    if (NV_eq_nowarn((NV)(SvIVX(sv)), SvNVX(sv)))
                         SvIOK_on(sv);
                     /* Assumption: first non-preserved integer is < IV_MAX,
                        this NV is in the preserved range, therefore: */
@@ -2936,7 +2936,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
     else if (SvNOK(sv)) {
        if (SvTYPE(sv) < SVt_PVNV)
            sv_upgrade(sv, SVt_PVNV);
-       if (SvNVX(sv) == 0.0) {
+       if (NV_eq_nowarn(SvNVX(sv), 0.0)) {
            s = SvGROW_mutable(sv, 2);
            *s++ = '0';
            *s = '\0';
@@ -3182,7 +3182,7 @@ Perl_sv_2bool_flags(pTHX_ SV *sv, I32 flags)
                 }
                 else if((SvFLAGS(sv) & (SVf_IOK|SVf_NOK))) {
                     svb = (SvIOK(sv) && SvIVX(sv) != 0)
-                        || (SvNOK(sv) && SvNVX(sv) != 0.0);
+                        || (SvNOK(sv) && NV_ne_nowarn(SvNVX(sv), 0.0));
                 }
                 else {
                     flags = 0;
@@ -8348,8 +8348,8 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
     }
     if (flags & SVp_NOK) {
        const NV was = SvNVX(sv);
-       if (NV_OVERFLOWS_INTEGERS_AT &&
-           was >= NV_OVERFLOWS_INTEGERS_AT) {
+       if (NV_OVERFLOWS_INTEGERS_AT > 0 &&
+           !(was < NV_OVERFLOWS_INTEGERS_AT)) {
            /* diag_listed_as: Lost precision when %s %f by 1 */
            Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
                           "Lost precision when incrementing %" NVff " by 1",
@@ -8533,8 +8533,8 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv)
     oops_its_num:
        {
            const NV was = SvNVX(sv);
-           if (NV_OVERFLOWS_INTEGERS_AT &&
-               was <= -NV_OVERFLOWS_INTEGERS_AT) {
+           if (NV_OVERFLOWS_INTEGERS_AT > 0 &&
+               !(was > -NV_OVERFLOWS_INTEGERS_AT)) {
                /* diag_listed_as: Lost precision when %s %f by 1 */
                Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
                               "Lost precision when decrementing %" NVff " by 1",
@@ -9370,7 +9370,7 @@ Perl_sv_true(pTHX_ SV *const sv)
            return SvIVX(sv) != 0;
        else {
            if (SvNOK(sv))
-               return SvNVX(sv) != 0.0;
+               return NV_ne_nowarn(SvNVX(sv), 0.0);
            else
                return sv_2bool(sv);
        }
@@ -10335,7 +10335,7 @@ S_F0convert(NV nv, char *const endbuf, STRLEN *const len)
        char *p = endbuf;
        nv += 0.5;
        uv = (UV)nv;
-       if (uv & 1 && uv == nv)
+       if (uv & 1 && NV_eq_nowarn(uv, nv))
            uv--;                       /* Round to even */
        do {
            const unsigned dig = uv % 10;

diff --git a/sv.h b/sv.h
index bb9e6b0..58dc02d 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1762,7 +1762,7 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>.
        ? SvPVXtrue(sv)                                 \
     : (SvFLAGS(sv) & (SVf_IOK|SVf_NOK))                        \
        ? (   (SvIOK(sv) && SvIVX(sv) != 0)             \
-          || (SvNOK(sv) && SvNVX(sv) != 0.0))          \
+          || (SvNOK(sv) && NV_ne_nowarn(SvNVX(sv), 0.0))) \
     : (fallback))
 
 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)