Create fcn for lossless conversion of NV to IV

Essentially the same code was being used in three places, and had
undefined C behavior for some inputs.

This consolidates the code into one inline function, and rewrites it to
avoid undefined behavior.

diff --git a/embed.fnc b/embed.fnc
index 45597f6..259affd 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2272,6 +2272,7 @@ sR        |SV*    |refto          |NN SV* sv
 : Used in pp_hot.c
 pRxo   |GV*    |softref2xv     |NN SV *const sv|NN const char *const what \
                                |const svtype type|NN SV ***spp
+inR    |bool   |lossless_NV_to_IV|const NV nv|NN IV * ivp
 #endif
 
 #if defined(PERL_IN_PP_PACK_C)

diff --git a/embed.h b/embed.h
index 75c91f7..9178c51 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1924,6 +1924,9 @@
 #define do_delete_local()      S_do_delete_local(aTHX)
 #define refto(a)               S_refto(aTHX_ a)
 #  endif
+#  if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C)
+#define lossless_NV_to_IV      S_lossless_NV_to_IV
+#  endif
 #  if defined(PERL_IN_PP_CTL_C)
 #define check_type_and_open(a) S_check_type_and_open(aTHX_ a)
 #define destroy_matcher(a)     S_destroy_matcher(aTHX_ a)

diff --git a/inline.h b/inline.h
index 654f801..de1e33e 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -1913,6 +1913,40 @@ S_should_warn_nl(const char *pv) {
 
 #endif
 
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C)
+
+PERL_STATIC_INLINE bool
+S_lossless_NV_to_IV(const NV nv, IV *ivp)
+{
+    /* This function determines if the input NV 'nv' may be converted without
+     * loss of data to an IV.  If not, it returns FALSE taking no other action.
+     * But if it is possible, it does the conversion, returning TRUE, and
+     * storing the converted result in '*ivp' */
+
+    PERL_ARGS_ASSERT_LOSSLESS_NV_TO_IV;
+
+#  if  defined(Perl_isnan)
+
+    if (UNLIKELY(Perl_isnan(nv))) {
+        return FALSE;
+    }
+
+#  endif
+
+    if (UNLIKELY(nv < IV_MIN) || UNLIKELY(nv > IV_MAX)) {
+        return FALSE;
+    }
+
+    if ((IV) nv != nv) {
+        return FALSE;
+    }
+
+    *ivp = (IV) nv;
+    return TRUE;
+}
+
+#endif
+
 /* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
 
 #define MAX_CHARSET_NAME_LENGTH 2

diff --git a/pp.c b/pp.c
index c89cb71..0956121 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1268,16 +1268,10 @@ PP(pp_multiply)
             NV nr = SvNVX(svr);
             NV result;
 
-            if (
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
-                !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
-                && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
-#else
-                nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
-#endif
-                )
+            if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
                 /* nothing was lost by converting to IVs */
                 goto do_iv;
+            }
             SP--;
             result = nl * nr;
 #  if defined(__sgi) && defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE && NVSIZE == 16
@@ -1849,16 +1843,10 @@ PP(pp_subtract)
             NV nl = SvNVX(svl);
             NV nr = SvNVX(svr);
 
-            if (
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
-                !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
-                && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
-#else
-                nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
-#endif
-                )
+            if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
                 /* nothing was lost by converting to IVs */
                 goto do_iv;
+            }
             SP--;
             TARGn(nl - nr, 0); /* args not GMG, so can't be tainted */
             SETs(TARG);

diff --git a/pp_hot.c b/pp_hot.c
index 7d5ffc0..2df5df8 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1435,16 +1435,10 @@ PP(pp_add)
             NV nl = SvNVX(svl);
             NV nr = SvNVX(svr);
 
-            if (
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
-                !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
-                && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
-#else
-                nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
-#endif
-                )
+            if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
                 /* nothing was lost by converting to IVs */
                 goto do_iv;
+            }
             SP--;
             TARGn(nl + nr, 0); /* args not GMG, so can't be tainted */
             SETs(TARG);

diff --git a/proto.h b/proto.h
index 0f8feed..74a8e46 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5224,6 +5224,13 @@ STATIC SV*       S_refto(pTHX_ SV* sv)
 
 #endif
 #if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C)
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE bool        S_lossless_NV_to_IV(const NV nv, IV * ivp)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_LOSSLESS_NV_TO_IV     \
+       assert(ivp)
+#endif
+
 PERL_CALLCONV GV*      Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const svtype type, SV ***spp)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_SOFTREF2XV    \