diff --git a/perl-5.30.0-Remove-undefined-behavior-from-IV-shifting.patch b/perl-5.30.0-Remove-undefined-behavior-from-IV-shifting.patch new file mode 100644 index 0000000..31ad4cf --- /dev/null +++ b/perl-5.30.0-Remove-undefined-behavior-from-IV-shifting.patch @@ -0,0 +1,75 @@ +From 7e5b390a008ccad094a39c350f385d58e8a5102a Mon Sep 17 00:00:00 2001 +From: Karl Williamson +Date: Fri, 3 May 2019 13:57:47 -0600 +Subject: [PATCH] Remove undefined behavior from IV shifting +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +It is undefined behavior to shift a negative integer to the left. This +commit avoids that by treating the value as unsigned, then casting back +to integer for return. + +Petr Písař: Ported to 5.30.0 from +814735a391b874af8f00eaf89469e5ec7f38cd4aa. + +Signed-off-by: Petr Písař +--- + asan_ignore | 5 ----- + pp.c | 21 ++++++++++++++++++++- + 2 files changed, 20 insertions(+), 6 deletions(-) + +diff --git a/asan_ignore b/asan_ignore +index e0f5685..f520546 100644 +--- a/asan_ignore ++++ b/asan_ignore +@@ -18,11 +18,6 @@ + + fun:Perl_pp_i_* + +-# Perl's << is defined as using the underlying C's << operator, with the +-# same undefined behaviour for shifts greater than the word size. +-# (UVs normally, IVs with 'use integer') +- +-fun:Perl_pp_left_shift + + # this function numifies the field width in eg printf "%10f". + # It has its own overflow detection, so don't warn about it +diff --git a/pp.c b/pp.c +index 7afb090..3ca04e1 100644 +--- a/pp.c ++++ b/pp.c +@@ -1991,10 +1991,29 @@ static IV S_iv_shift(IV iv, int shift, bool left) + shift = -shift; + left = !left; + } ++ + if (UNLIKELY(shift >= IV_BITS)) { + return iv < 0 && !left ? -1 : 0; + } +- return left ? iv << shift : iv >> shift; ++ /* For left shifts, perl 5 has chosen to treat the value as unsigned for ++ * the * purposes of shifting, then cast back to signed. This is very ++ * different from perl 6: ++ * ++ * $ perl6 -e 'say -2 +< 5' ++ * -64 ++ * ++ * $ ./perl -le 'print -2 << 5' ++ * 18446744073709551552 ++ * */ ++ if (left) { ++ if (iv == IV_MIN) { /* Casting this to a UV is undefined behavior */ ++ return 0; ++ } ++ return (IV) (((UV) iv) << shift); ++ } ++ ++ /* Here is right shift */ ++ return iv >> shift; + } + + #define UV_LEFT_SHIFT(uv, shift) S_uv_shift(uv, shift, TRUE) +-- +2.20.1 + diff --git a/perl-5.30.0-pp.c-Add-two-UNLIKELY-s.patch b/perl-5.30.0-pp.c-Add-two-UNLIKELY-s.patch new file mode 100644 index 0000000..4565e07 --- /dev/null +++ b/perl-5.30.0-pp.c-Add-two-UNLIKELY-s.patch @@ -0,0 +1,42 @@ +From 4f0ded009bf6de2da6a2a2022bec03576dcb80ca Mon Sep 17 00:00:00 2001 +From: Karl Williamson +Date: Wed, 1 May 2019 10:41:38 -0600 +Subject: [PATCH] pp.c: Add two UNLIKELY()s +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +It should be uncommon to shift beyond a full word + +Signed-off-by: Ported to 5.30.0 from +bae047b68c92622bb4bb04499e36cdaa48138909. +Signed-off-by: Petr Písař +--- + pp.c | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) + +diff --git a/pp.c b/pp.c +index 90db3a0..7afb090 100644 +--- a/pp.c ++++ b/pp.c +@@ -1979,7 +1979,7 @@ static UV S_uv_shift(UV uv, int shift, bool left) + shift = -shift; + left = !left; + } +- if (shift >= IV_BITS) { ++ if (UNLIKELY(shift >= IV_BITS)) { + return 0; + } + return left ? uv << shift : uv >> shift; +@@ -1991,7 +1991,7 @@ static IV S_iv_shift(IV iv, int shift, bool left) + shift = -shift; + left = !left; + } +- if (shift >= IV_BITS) { ++ if (UNLIKELY(shift >= IV_BITS)) { + return iv < 0 && !left ? -1 : 0; + } + return left ? iv << shift : iv >> shift; +-- +2.20.1 + diff --git a/perl-5.31.0-Create-fcn-for-lossless-conversion-of-NV-to-IV.patch b/perl-5.31.0-Create-fcn-for-lossless-conversion-of-NV-to-IV.patch new file mode 100644 index 0000000..c072cec --- /dev/null +++ b/perl-5.31.0-Create-fcn-for-lossless-conversion-of-NV-to-IV.patch @@ -0,0 +1,181 @@ +From 3a019afd6f6291c3249c254b5c01e244e4ec83ab Mon Sep 17 00:00:00 2001 +From: Karl Williamson +Date: Sun, 28 Apr 2019 17:42:44 -0600 +Subject: [PATCH 1/3] Create fcn for lossless conversion of NV to IV +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +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. + +Signed-off-by: Petr Písař +--- + embed.fnc | 1 + + embed.h | 3 +++ + inline.h | 34 ++++++++++++++++++++++++++++++++++ + pp.c | 20 ++++---------------- + pp_hot.c | 10 ++-------- + proto.h | 7 +++++++ + 6 files changed, 51 insertions(+), 24 deletions(-) + +diff --git a/embed.fnc b/embed.fnc +index 45597f67b6..259affded0 100644 +--- 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 75c91f77f4..9178c51e92 100644 +--- 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 654f801b75..de1e33e8ce 100644 +--- 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 c89cb7198c..0956121b27 100644 +--- 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 7d5ffc02fd..2df5df8303 100644 +--- 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 0f8feed187..74a8e46ab7 100644 +--- 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 \ +-- +2.20.1 + diff --git a/perl.spec b/perl.spec index 4131e6e..4165032 100644 --- a/perl.spec +++ b/perl.spec @@ -157,6 +157,11 @@ Patch15: perl-5.31.0-PATCH-perl-134059-panic-outputting-a-warning.patch # Fix memory handling when parsing string literals, fixed after 5.31.0 Patch16: perl-5.31.0-S_scan_const-Properly-test-if-need-to-grow.patch +# Fix an undefined behavior in shifting IV variables, fixed after 5.31.0 +Patch17: perl-5.31.0-Create-fcn-for-lossless-conversion-of-NV-to-IV.patch +Patch18: perl-5.30.0-pp.c-Add-two-UNLIKELY-s.patch +Patch19: perl-5.30.0-Remove-undefined-behavior-from-IV-shifting.patch + # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048 Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch @@ -2691,6 +2696,9 @@ Perl extension for Version Objects %patch14 -p1 %patch15 -p1 %patch16 -p1 +%patch17 -p1 +%patch18 -p1 +%patch19 -p1 %patch200 -p1 %patch201 -p1 @@ -2714,6 +2722,9 @@ perl -x patchlevel.h \ 'Fedora Patch14: Fix an out-of-buffer read while parsing a Unicode property name (RT#134134)' \ 'Fedora Patch15: Do not panic when outputting a warning (RT#134059)' \ 'Fedora Patch16: Fix memory handling when parsing string literals' \ + 'Fedora Patch17: Fix an undefined behavior in shifting IV variables' \ + 'Fedora Patch18: Fix an undefined behavior in shifting IV variables' \ + 'Fedora Patch19: Fix an undefined behavior in shifting IV variables' \ 'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \ 'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \ %{nil} @@ -4963,6 +4974,7 @@ popd - Fix an out-of-buffer read while parsing a Unicode property name (RT#134134) - Do not panic when outputting a warning (RT#134059) - Fix memory handling when parsing string literals +- Fix an undefined behavior in shifting IV variables * Tue Jun 11 2019 Jitka Plesnikova - 4:5.30.0-439 - Define %%perl_vendor*, %%perl_archlib, %%perl_privlib, because in rpm