diff --git a/CVE-2018-18312-1.patch b/CVE-2018-18312-1.patch deleted file mode 100644 index 41ea4674fc7672151939ec5a8efb0abbf1ec1e28..0000000000000000000000000000000000000000 --- a/CVE-2018-18312-1.patch +++ /dev/null @@ -1,10 +0,0 @@ ---- a/regcomp.c 2018-05-21 20:29:23.000000000 +0800 -+++ b/regcomp.c 2019-04-11 09:51:08.493000000 +0800 -@@ -15591,7 +15591,6 @@ redo_curchar: - if (UCHARAT(RExC_parse) != ')') - vFAIL("Expecting close paren for wrapper for nested extended charclass"); - -- RExC_parse++; - RExC_flags = save_flags; - goto handle_operand; - } diff --git a/CVE-2018-18312-2.patch b/CVE-2018-18312-2.patch deleted file mode 100644 index 1a0e80f55e7aaf92df9615ee10c9264919f7228a..0000000000000000000000000000000000000000 --- a/CVE-2018-18312-2.patch +++ /dev/null @@ -1,11 +0,0 @@ ---- a/t/re/reg_mesg.t 2018-05-21 20:29:23.000000000 +0800 -+++ b/t/re/reg_mesg.t 2019-04-11 09:54:59.622000000 +0800 -@@ -122,6 +122,8 @@ my $tab_hex = sprintf "%02X", ord("\t"); - # - # The first set are those that should be fatal errors. - -+my $bug133423 = "(?[(?^:(?[\\\x00]))\\]\x00|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670"; -+ - my @death = - ( - '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/[[=foo=]{#}]/', diff --git a/CVE-2018-18312-3.patch b/CVE-2018-18312-3.patch deleted file mode 100644 index 1535dfeb67c945c6788fb55aff46ffd8d70dfb71..0000000000000000000000000000000000000000 --- a/CVE-2018-18312-3.patch +++ /dev/null @@ -1,10 +0,0 @@ ---- a/t/re/reg_mesg-change.t 2019-04-11 10:07:36.626000000 +0800 -+++ b/t/re/reg_mesg.t 2019-04-11 10:08:20.032000000 +0800 -@@ -309,6 +309,7 @@ my @death = - '/\A{/' => 'Unescaped left brace in regex is illegal here {#} m/\A{{#}/', - '/(?<=/' => 'Sequence (?... not terminated {#} m/(?<={#}/', # [perl #128170] - '/\p{vertical tab}/' => 'Can\'t find Unicode property definition "vertical tab" {#} m/\\p{vertical tab}{#}/', # [perl #132055] -+ "/$bug133423/" => "Operand with no preceding operator {#} m/(?[(?^:(?[\\\0]))\\{#}]\0|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670/", - - ); - diff --git a/Fix-script-run-bug-1-followed-by-Thai-digit.patch b/Fix-script-run-bug-1-followed-by-Thai-digit.patch deleted file mode 100644 index 6ab31ea00881733131b6505440b24b9a5a6d99a6..0000000000000000000000000000000000000000 --- a/Fix-script-run-bug-1-followed-by-Thai-digit.patch +++ /dev/null @@ -1,93 +0,0 @@ -From 7da8e27b9d7d2be4e770d074405ddb9941e6c8b7 Mon Sep 17 00:00:00 2001 -From: Karl Williamson -Date: Thu, 16 Aug 2018 16:14:01 -0600 -Subject: [PATCH] Fix script run bug '1' followed by Thai digit - -This does not have a ticket, but was pointed out in -http://nntp.perl.org/group/perl.perl5.porters/251870 - -The logic for deciding if it was needed to check if a character is a -digit was flawed. ---- - regexec.c | 46 +++++++++++++++++++++++++++++++--------------- - t/re/script_run.t | 5 +++++ - 2 files changed, 36 insertions(+), 15 deletions(-) - -diff --git a/regexec.c b/regexec.c -index 6f39670c4a..c927abc611 100644 ---- a/regexec.c -+++ b/regexec.c -@@ -10626,23 +10626,39 @@ Perl_isSCRIPT_RUN(pTHX_ const U8 * s, const U8 * send, const bool utf8_target) - scripts_match: - - /* Here, the script of the character is compatible with that of the -- * run. Either they match exactly, or one or both can be any of -- * several scripts, and the intersection is not empty. If the -- * character is not a decimal digit, we are done with it. Otherwise, -- * it could still fail if it is from a different set of 10 than seen -- * already (or we may not have seen any, and we need to set the -- * sequence). If we have determined a single script and that script -- * only has one set of digits (almost all scripts are like that), then -- * this isn't a problem, as any digit must come from the same sequence. -- * The only scripts that have multiple sequences have been constructed -- * to be 0 in 'script_zeros[]'. -+ * run. That means that in most cases, it continues the script run. -+ * Either it and the run match exactly, or one or both can be in any of -+ * several scripts, and the intersection is not empty. But if the -+ * character is a decimal digit, we need further handling. If we -+ * haven't seen a digit before, it would establish what set of 10 all -+ * must come from; and if we have established a set, we need to check -+ * that this is in it. - * -- * Here we check if it is a digit. */ -+ * But there are cases we can rule out without having to look up if -+ * this is a digit: -+ * a. All instances of [0-9] have been dealt with earlier. -+ * b. The next digit encoded by Unicode is 1600 code points further -+ * on, so if the code point in this loop iteration is less than -+ * that, it isn't a digit. -+ * c. Most scripts that have digits have a single set of 10. If -+ * we've encountered a digit in such a script, 'zero_of_run' is -+ * set to the code point (call it z) whose numeric value is 0. -+ * If the code point in this loop iteration is in the range -+ * z..z+9, it is in the script's set of 10, and we've actually -+ * handled it earlier in this function and won't reach this -+ * point. But, code points in that script that aren't in that -+ * range can't be digits, so we don't have to look any such up. -+ * We can tell if this script is such a one by looking at -+ * 'script_zeros[]' for it. It is non-zero iff it has a single -+ * set of digits. This rule doesn't apply if we haven't narrowed -+ * down the possible scripts to a single one yet. Nor if the -+ * zero of the run is '0', as that also hasn't narrowed things -+ * down completely */ - if ( cp >= FIRST_NON_ASCII_DECIMAL_DIGIT -- && ( ( zero_of_run == 0 -- || ( ( script_of_char >= 0 -- && script_zeros[script_of_char] == 0) -- || intersection)))) -+ && ( intersection -+ || script_of_char < 0 /* Also implies an intersection */ -+ || zero_of_run == '0' -+ || script_zeros[script_of_char] == 0)) - { - SSize_t range_zero_index; - range_zero_index = _invlist_search(decimals_invlist, cp); -diff --git a/t/re/script_run.t b/t/re/script_run.t -index ca234d9d4e..10c71034c4 100644 ---- a/t/re/script_run.t -+++ b/t/re/script_run.t -@@ -84,6 +84,11 @@ foreach my $type ('script_run', 'sr', 'atomic_script_run', 'asr') { - - # From UTS 39 - like("写真だけの結婚式", $script_run, "Mixed Hiragana and Han"); -+ -+ unlike "\N{THAI DIGIT FIVE}1", $script_run, "Thai digit followed by '1'"; -+ unlike "1\N{THAI DIGIT FIVE}", $script_run, "'1' followed by Thai digit "; -+ unlike "\N{BENGALI DIGIT ZERO}\N{CHAKMA DIGIT SEVEN}", $script_run, -+ "Two digits in same extended script but from different sets of 10"; - } - - # Until fixed, this was skipping the '[' --- -2.19.1 - diff --git a/Perl_my_setenv-handle-integer-wrap.patch b/Perl_my_setenv-handle-integer-wrap.patch deleted file mode 100644 index 5e9363c51c2178a68f4dfef50c823aeadfea5db2..0000000000000000000000000000000000000000 --- a/Perl_my_setenv-handle-integer-wrap.patch +++ /dev/null @@ -1,175 +0,0 @@ -From 34716e2a6ee2af96078d62b065b7785c001194be Mon Sep 17 00:00:00 2001 -From: David Mitchell -Date: Fri, 29 Jun 2018 13:37:03 +0100 -Subject: [PATCH] Perl_my_setenv(); handle integer wrap - -RT #133204 - -Wean this function off int/I32 and onto UV/Size_t. -Also, replace all malloc-ish calls with a wrapper that does -overflow checks, - -In particular, it was doing (nlen + vlen + 2) which could wrap when -the combined length of the environment variable name and value -exceeded around 0x7fffffff. - -The wrapper check function is probably overkill, but belt and braces... - -NB this function has several variant parts, #ifdef'ed by platform -type; I have blindly changed the parts that aren't compiled under linux. ---- - util.c | 76 ++++++++++++++++++++++++++++++++++++++++------------------ - 1 file changed, 53 insertions(+), 23 deletions(-) - -diff --git a/util.c b/util.c -index 7282dd9cfe..c5c7becc0f 100644 ---- a/util.c -+++ b/util.c -@@ -2061,8 +2061,40 @@ Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits, - *(s+(nlen+1+vlen)) = '\0' - - #ifdef USE_ENVIRON_ARRAY -- /* VMS' my_setenv() is in vms.c */ -+ -+/* small wrapper for use by Perl_my_setenv that mallocs, or reallocs if -+ * 'current' is non-null, with up to three sizes that are added together. -+ * It handles integer overflow. -+ */ -+static char * -+S_env_alloc(void *current, Size_t l1, Size_t l2, Size_t l3, Size_t size) -+{ -+ void *p; -+ Size_t sl, l = l1 + l2; -+ -+ if (l < l2) -+ goto panic; -+ l += l3; -+ if (l < l3) -+ goto panic; -+ sl = l * size; -+ if (sl < l) -+ goto panic; -+ -+ p = current -+ ? safesysrealloc(current, sl) -+ : safesysmalloc(sl); -+ if (p) -+ return (char*)p; -+ -+ panic: -+ croak_memory_wrap(); -+} -+ -+ -+/* VMS' my_setenv() is in vms.c */ - #if !defined(WIN32) && !defined(NETWARE) -+ - void - Perl_my_setenv(pTHX_ const char *nam, const char *val) - { -@@ -2078,28 +2110,27 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) - #ifndef PERL_USE_SAFE_PUTENV - if (!PL_use_safe_putenv) { - /* most putenv()s leak, so we manipulate environ directly */ -- I32 i; -- const I32 len = strlen(nam); -- int nlen, vlen; -+ UV i; -+ Size_t vlen, nlen = strlen(nam); - - /* where does it go? */ - for (i = 0; environ[i]; i++) { -- if (strnEQ(environ[i],nam,len) && environ[i][len] == '=') -+ if (strnEQ(environ[i], nam, nlen) && environ[i][nlen] == '=') - break; - } - - if (environ == PL_origenviron) { /* need we copy environment? */ -- I32 j; -- I32 max; -+ UV j, max; - char **tmpenv; - - max = i; - while (environ[max]) - max++; -- tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*)); -+ /* XXX shouldn't that be max+1 rather than max+2 ??? - DAPM */ -+ tmpenv = (char**)S_env_alloc(NULL, max, 2, 0, sizeof(char*)); - for (j=0; j -Date: Wed, 20 Nov 2019 20:02:45 -0600 -Subject: [PATCH] regcomp.c: Prevent integer overflow from nested regex - quantifiers. - -(CVE-2020-10543) On 32bit systems the size calculations for nested regular -expression quantifiers could overflow causing heap memory corruption. - -Fixes: Perl/perl5-security#125 -(cherry picked from commit bfd31397db5dc1a5c5d3e0a1f753a4f89a736e71) - -port from: -https://github.com/perl/perl5/commit/897d1f7fd515b828e4b198d8b8bef76c6faf03ed - -Signed-off-by: Peibao Liu ---- - regcomp.c | 6 ++++++ - 1 file changed, 6 insertions(+) - -diff -Naur a/regcomp.c b/regcomp.c ---- a/regcomp.c 2020-07-14 14:52:25.197000000 -0400 -+++ b/regcomp.c 2020-07-14 14:56:41.823000000 -0400 -@@ -5181,6 +5181,12 @@ - (void)ReREFCNT_inc(RExC_rx_sv); - } - -+ if ( ( minnext > 0 && mincount >= SSize_t_MAX / minnext ) -+ || min >= SSize_t_MAX - minnext * mincount ) -+ { -+ FAIL("Regexp out of space"); -+ } -+ - min += minnext * mincount; - is_inf_internal |= deltanext == SSize_t_MAX - || (maxcount == REG_INFTY && minnext + deltanext > 0); diff --git a/backport-CVE-2020-10878.patch b/backport-CVE-2020-10878.patch deleted file mode 100644 index 5723183b27a8e328c6c73b4b81fc55509a39b8c3..0000000000000000000000000000000000000000 --- a/backport-CVE-2020-10878.patch +++ /dev/null @@ -1,144 +0,0 @@ -From 0a320d753fe7fca03df259a4dfd8e641e51edaa8 Mon Sep 17 00:00:00 2001 -From: Hugo van der Sanden -Date: Tue, 18 Feb 2020 13:51:16 +0000 -Subject: [PATCH] study_chunk: extract rck_elide_nothing - -(CVE-2020-10878) - -(cherry picked from commit 93dee06613d4e1428fb10905ce1c3c96f53113dc) ---- - embed.fnc | 1 + - embed.h | 1 + - proto.h | 3 +++ - regcomp.c | 70 ++++++++++++++++++++++++++++++++++--------------------- - 4 files changed, 48 insertions(+), 27 deletions(-) - -diff -Naur a/embed.fnc b/embed.fnc ---- a/embed.fnc 2020-07-14 15:07:54.374000000 -0400 -+++ b/embed.fnc 2020-07-14 15:14:46.619000000 -0400 -@@ -2476,6 +2476,7 @@ - |I32 stopparen|U32 recursed_depth \ - |NULLOK regnode_ssc *and_withp \ - |U32 flags|U32 depth -+Es |void |rck_elide_nothing|NN regnode *node - EsR |SV * |get_ANYOFM_contents|NN const regnode * n - EsRn |U32 |add_data |NN RExC_state_t* const pRExC_state \ - |NN const char* const s|const U32 n -diff -Naur a/embed.h b/embed.h ---- a/embed.h 2020-07-14 15:07:54.399000000 -0400 -+++ b/embed.h 2020-07-14 15:15:08.491000000 -0400 -@@ -1202,6 +1202,7 @@ - #define output_or_return_posix_warnings(a,b,c) S_output_or_return_posix_warnings(aTHX_ a,b,c) - #define parse_lparen_question_flags(a) S_parse_lparen_question_flags(aTHX_ a) - #define populate_ANYOF_from_invlist(a,b) S_populate_ANYOF_from_invlist(aTHX_ a,b) -+#define rck_elide_nothing(a) S_rck_elide_nothing(aTHX_ a) - #define reg(a,b,c,d) S_reg(aTHX_ a,b,c,d) - #define reg2Lanode(a,b,c,d) S_reg2Lanode(aTHX_ a,b,c,d) - #define reg_node(a,b) S_reg_node(aTHX_ a,b) -diff -Naur a/proto.h b/proto.h ---- a/proto.h 2020-07-14 15:07:54.369000000 -0400 -+++ b/proto.h 2020-07-14 15:15:37.435000000 -0400 -@@ -5482,6 +5482,9 @@ - STATIC void S_populate_ANYOF_from_invlist(pTHX_ regnode *node, SV** invlist_ptr); - #define PERL_ARGS_ASSERT_POPULATE_ANYOF_FROM_INVLIST \ - assert(node); assert(invlist_ptr) -+STATIC void S_rck_elide_nothing(pTHX_ regnode *node); -+#define PERL_ARGS_ASSERT_RCK_ELIDE_NOTHING \ -+ assert(node) - PERL_STATIC_NO_RET void S_re_croak2(pTHX_ bool utf8, const char* pat1, const char* pat2, ...) - __attribute__noreturn__; - #define PERL_ARGS_ASSERT_RE_CROAK2 \ -diff -Naur a/regcomp.c b/regcomp.c ---- a/regcomp.c 2020-07-14 15:07:54.394000000 -0400 -+++ b/regcomp.c 2020-07-14 15:17:39.845000000 -0400 -@@ -4178,6 +4178,44 @@ - } while (f); - } - -+/* Follow the next-chain of the current node and optimize away -+ * all the NOTHINGs from it. -+ * */ -+STATIC void -+S_rck_elide_nothing(pTHX_ regnode *node) -+{ -+ dVAR; -+ -+ PERL_ARGS_ASSERT_RCK_ELIDE_NOTHING; -+ -+ if (OP(node) != CURLYX) { -+ const int max = (reg_off_by_arg[OP(node)] -+ ? I32_MAX -+ /* I32 may be smaller than U16 on CRAYs! */ -+ : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX)); -+ int off = (reg_off_by_arg[OP(node)] ? ARG(node) : NEXT_OFF(node)); -+ int noff; -+ regnode *n = node; -+ -+ /* Skip NOTHING and LONGJMP. */ -+ while ( -+ (n = regnext(n)) -+ && ( -+ (PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n))) -+ || ((OP(n) == LONGJMP) && (noff = ARG(n))) -+ ) -+ && off + noff < max -+ ) { -+ off += noff; -+ } -+ if (reg_off_by_arg[OP(node)]) -+ ARG(node) = off; -+ else -+ NEXT_OFF(node) = off; -+ } -+ return; -+} -+ - /* the return from this sub is the minimum length that could possibly match */ - STATIC SSize_t - S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, -@@ -4277,28 +4315,10 @@ - */ - JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0); - -- /* Follow the next-chain of the current node and optimize -- away all the NOTHINGs from it. */ -- if (OP(scan) != CURLYX) { -- const int max = (reg_off_by_arg[OP(scan)] -- ? I32_MAX -- /* I32 may be smaller than U16 on CRAYs! */ -- : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX)); -- int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan)); -- int noff; -- regnode *n = scan; -- -- /* Skip NOTHING and LONGJMP. */ -- while ((n = regnext(n)) -- && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n))) -- || ((OP(n) == LONGJMP) && (noff = ARG(n)))) -- && off + noff < max) -- off += noff; -- if (reg_off_by_arg[OP(scan)]) -- ARG(scan) = off; -- else -- NEXT_OFF(scan) = off; -- } -+ /* Follow the next-chain of the current node and optimize -+ away all the NOTHINGs from it. -+ */ -+ rck_elide_nothing(scan); - - /* The principal pseudo-switch. Cannot be a switch, since we - look into several different things. */ -@@ -5425,11 +5445,7 @@ - if (data && (fl & SF_HAS_EVAL)) - data->flags |= SF_HAS_EVAL; - optimize_curly_tail: -- if (OP(oscan) != CURLYX) { -- while (PL_regkind[OP(next = regnext(oscan))] == NOTHING -- && NEXT_OFF(next)) -- NEXT_OFF(oscan) += NEXT_OFF(next); -- } -+ rck_elide_nothing(oscan); - continue; - - default: diff --git a/backport-CVE-2020-12723.patch b/backport-CVE-2020-12723.patch deleted file mode 100644 index 6e921af450c72ff2b70b3796437d154b4313e14a..0000000000000000000000000000000000000000 --- a/backport-CVE-2020-12723.patch +++ /dev/null @@ -1,277 +0,0 @@ -From c0b79e3c354b25f9fb732bd49f668ae5eeaa723a Mon Sep 17 00:00:00 2001 -From: Hugo van der Sanden -Date: Sat, 11 Apr 2020 14:10:24 +0100 -Subject: [PATCH] study_chunk: avoid mutating regexp program within GOSUB - -gh16947 and gh17743: studying GOSUB may restudy in an inner call -(via a mix of recursion and enframing) something that an outer call -is in the middle of looking at. Let the outer frame deal with it. - -(CVE-2020-12723) - -(cherry picked from commit c4033e740bd18d9fbe3456a9db2ec2053cdc5271) - -port from: -https://github.com/perl/perl5/commit/66bbb51b93253a3f87d11c2695cfb7bdb782184a - -Signed-off-by: Peibao Liu ---- - embed.fnc | 2 +- - embed.h | 2 +- - proto.h | 2 +- - regcomp.c | 42 ++++++++++++++++++++++++++++++------------ - t/re/pat.t | 27 ++++++++++++++++++++++++++- - 5 files changed, 59 insertions(+), 16 deletions(-) - -diff -Naur a/embed.fnc b/embed.fnc ---- a/embed.fnc 2020-07-14 15:18:38.077000000 -0400 -+++ b/embed.fnc 2020-07-14 15:21:38.116000000 -0400 -@@ -2475,7 +2475,7 @@ - |NULLOK struct scan_data_t *data \ - |I32 stopparen|U32 recursed_depth \ - |NULLOK regnode_ssc *and_withp \ -- |U32 flags|U32 depth -+ |U32 flags|U32 depth|bool was_mutate_ok - Es |void |rck_elide_nothing|NN regnode *node - EsR |SV * |get_ANYOFM_contents|NN const regnode * n - EsRn |U32 |add_data |NN RExC_state_t* const pRExC_state \ -diff -Naur a/embed.h b/embed.h ---- a/embed.h 2020-07-14 15:18:38.095000000 -0400 -+++ b/embed.h 2020-07-14 15:21:58.416000000 -0400 -@@ -1232,7 +1232,7 @@ - #define ssc_is_cp_posixl_init S_ssc_is_cp_posixl_init - #define ssc_or(a,b,c) S_ssc_or(aTHX_ a,b,c) - #define ssc_union(a,b,c) S_ssc_union(aTHX_ a,b,c) --#define study_chunk(a,b,c,d,e,f,g,h,i,j,k) S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k) -+#define study_chunk(a,b,c,d,e,f,g,h,i,j,k,l) S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l) - # endif - # if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C) - #define _invlist_dump(a,b,c,d) Perl__invlist_dump(aTHX_ a,b,c,d) -diff -Naur a/proto.h b/proto.h ---- a/proto.h 2020-07-14 15:18:38.074000000 -0400 -+++ b/proto.h 2020-07-14 15:22:41.447000000 -0400 -@@ -5593,7 +5593,7 @@ - #define PERL_ARGS_ASSERT_SSC_UNION \ - assert(ssc); assert(invlist) - #endif --STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, regnode *last, struct scan_data_t *data, I32 stopparen, U32 recursed_depth, regnode_ssc *and_withp, U32 flags, U32 depth); -+STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, regnode *last, struct scan_data_t *data, I32 stopparen, U32 recursed_depth, regnode_ssc *and_withp, U32 flags, U32 depth, bool was_mutate_ok); - #define PERL_ARGS_ASSERT_STUDY_CHUNK \ - assert(pRExC_state); assert(scanp); assert(minlenp); assert(deltap); assert(last) - #endif -diff -Naur a/regcomp.c b/regcomp.c ---- a/regcomp.c 2020-07-14 15:18:38.091000000 -0400 -+++ b/regcomp.c 2020-07-14 15:34:01.739000000 -0400 -@@ -110,6 +110,7 @@ - regnode *next_regnode; /* next node to process when last is reached */ - U32 prev_recursed_depth; - I32 stopparen; /* what stopparen do we use */ -+ bool in_gosub; /* this or an outer frame is for GOSUB */ - - struct scan_frame *this_prev_frame; /* this previous frame */ - struct scan_frame *prev_frame; /* previous frame */ -@@ -4225,7 +4226,7 @@ - I32 stopparen, - U32 recursed_depth, - regnode_ssc *and_withp, -- U32 flags, U32 depth) -+ U32 flags, U32 depth, bool was_mutate_ok) - /* scanp: Start here (read-write). */ - /* deltap: Write maxlen-minlen here. */ - /* last: Stop before this one. */ -@@ -4303,6 +4304,10 @@ - node length to get a real minimum (because - the folded version may be shorter) */ - bool unfolded_multi_char = FALSE; -+ /* avoid mutating ops if we are anywhere within the recursed or -+ * enframed handling for a GOSUB: the outermost level will handle it. -+ */ -+ bool mutate_ok = was_mutate_ok && !(frame && frame->in_gosub); - /* Peephole optimizer: */ - DEBUG_STUDYDATA("Peep", data, depth, is_inf); - DEBUG_PEEP("Peep", scan, depth, flags); -@@ -4313,7 +4318,8 @@ - * parsing code, as each (?:..) is handled by a different invocation of - * reg() -- Yves - */ -- JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0); -+ if (mutate_ok) -+ JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0); - - /* Follow the next-chain of the current node and optimize - away all the NOTHINGs from it. -@@ -4345,7 +4351,7 @@ - /* DEFINEP study_chunk() recursion */ - (void)study_chunk(pRExC_state, &scan, &minlen, - &deltanext, next, &data_fake, stopparen, -- recursed_depth, NULL, f, depth+1); -+ recursed_depth, NULL, f, depth+1, mutate_ok); - - scan = next; - } else -@@ -4413,7 +4419,8 @@ - /* recurse study_chunk() for each BRANCH in an alternation */ - minnext = study_chunk(pRExC_state, &scan, minlenp, - &deltanext, next, &data_fake, stopparen, -- recursed_depth, NULL, f,depth+1); -+ recursed_depth, NULL, f, depth+1, -+ mutate_ok); - - if (min1 > minnext) - min1 = minnext; -@@ -4480,9 +4487,10 @@ - } - } - -- if (PERL_ENABLE_TRIE_OPTIMISATION && -- OP( startbranch ) == BRANCH ) -- { -+ if (PERL_ENABLE_TRIE_OPTIMISATION -+ && OP(startbranch) == BRANCH -+ && mutate_ok -+ ) { - /* demq. - - Assuming this was/is a branch we are dealing with: 'scan' -@@ -4933,6 +4941,9 @@ - newframe->stopparen = stopparen; - newframe->prev_recursed_depth = recursed_depth; - newframe->this_prev_frame= frame; -+ newframe->in_gosub = ( -+ (frame && frame->in_gosub) || OP(scan) == GOSUB -+ ); - - DEBUG_STUDYDATA("frame-new", data, depth, is_inf); - DEBUG_PEEP("fnew", scan, depth, flags); -@@ -5153,7 +5164,7 @@ - (mincount == 0 - ? (f & ~SCF_DO_SUBSTR) - : f) -- ,depth+1); -+ , depth+1, mutate_ok); - - if (flags & SCF_DO_STCLASS) - data->start_class = oclass; -@@ -5221,7 +5232,9 @@ - if ( OP(oscan) == CURLYX && data - && data->flags & SF_IN_PAR - && !(data->flags & SF_HAS_EVAL) -- && !deltanext && minnext == 1 ) { -+ && !deltanext && minnext == 1 -+ && mutate_ok -+ ) { - /* Try to optimize to CURLYN. */ - regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; - regnode * const nxt1 = nxt; -@@ -5267,10 +5280,10 @@ - && !(data->flags & SF_HAS_EVAL) - && !deltanext /* atom is fixed width */ - && minnext != 0 /* CURLYM can't handle zero width */ -- - /* Nor characters whose fold at run-time may be - * multi-character */ - && ! (RExC_seen & REG_UNFOLDED_MULTI_SEEN) -+ && mutate_ok - ) { - /* XXXX How to optimize if data == 0? */ - /* Optimize to a simpler form. */ -@@ -5318,7 +5331,8 @@ - /* Optimize again: */ - /* recurse study_chunk() on optimised CURLYX => CURLYM */ - study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt, -- NULL, stopparen, recursed_depth, NULL, 0,depth+1); -+ NULL, stopparen, recursed_depth, NULL, 0, -+ depth+1, mutate_ok); - } - else - oscan->flags = 0; -@@ -5735,7 +5749,8 @@ - /* recurse study_chunk() for lookahead body */ - minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext, - last, &data_fake, stopparen, -- recursed_depth, NULL, f, depth+1); -+ recursed_depth, NULL, f, depth+1, -+ mutate_ok); - if (scan->flags) { - if (deltanext) { - FAIL("Variable length lookbehind not implemented"); -@@ -5827,7 +5842,7 @@ - *minnextp = study_chunk(pRExC_state, &nscan, minnextp, - &deltanext, last, &data_fake, - stopparen, recursed_depth, NULL, -- f,depth+1); -+ f, depth+1, mutate_ok); - if (scan->flags) { - if (deltanext) { - FAIL("Variable length lookbehind not implemented"); -@@ -5988,7 +6003,8 @@ - /* optimise study_chunk() for TRIE */ - minnext = study_chunk(pRExC_state, &scan, minlenp, - &deltanext, (regnode *)nextbranch, &data_fake, -- stopparen, recursed_depth, NULL, f,depth+1); -+ stopparen, recursed_depth, NULL, f, depth+1, -+ mutate_ok); - } - if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH) - nextbranch= regnext((regnode*)nextbranch); -@@ -7673,7 +7689,7 @@ - &data, -1, 0, NULL, - SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag - | (restudied ? SCF_TRIE_DOING_RESTUDY : 0), -- 0); -+ 0, TRUE); - - - CHECK_RESTUDY_GOTO_butfirst(LEAVE_with_name("study_chunk")); -@@ -7802,7 +7818,7 @@ - SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS|(restudied - ? SCF_TRIE_DOING_RESTUDY - : 0), -- 0); -+ 0, TRUE); - - CHECK_RESTUDY_GOTO_butfirst(NOOP); - -diff -Naur a/t/re/pat.t b/t/re/pat.t ---- a/t/re/pat.t 2020-07-14 15:18:37.898000000 -0400 -+++ b/t/re/pat.t 2020-07-14 15:40:01.252000000 -0400 -@@ -23,7 +23,7 @@ - skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader; - skip_all_without_unicode_tables(); - --plan tests => 848; # Update this when adding/deleting tests. -+plan tests => 852; # Update this when adding/deleting tests. - - run_tests() unless caller; - -@@ -1948,6 +1948,30 @@ - fresh_perl_is('m m0*0+\Rm', "",{},"Undefined behavior in address sanitizer"); - } - -+ # gh16947: test regexp corruption (GOSUB) -+ { -+ fresh_perl_is(q{ -+ 'xy' =~ /x(?0)|x(?|y|y)/ && print 'ok' -+ }, 'ok', {}, 'gh16947: test regexp corruption (GOSUB)'); -+ } -+ # gh16947: test fix doesn't break SUSPEND -+ { -+ fresh_perl_is(q{ 'sx' =~ m{ss++}i; print 'ok' }, -+ 'ok', {}, "gh16947: test fix doesn't break SUSPEND"); -+ } -+ -+ # gh17743: more regexp corruption via GOSUB -+ { -+ fresh_perl_is(q{ -+ "0" =~ /((0(?0)|000(?|0000|0000)(?0))|)/; print "ok" -+ }, 'ok', {}, 'gh17743: test regexp corruption (1)'); -+ -+ fresh_perl_is(q{ -+ "000000000000" =~ /(0(())(0((?0)())|000(?|\x{ef}\x{bf}\x{bd}|\x{ef}\x{bf}\x{bd}))|)/; -+ print "ok" -+ }, 'ok', {}, 'gh17743: test regexp corruption (2)'); -+ } -+ - } # End of sub run_tests - - 1; diff --git a/create-libperl-soname.patch b/create-libperl-soname.patch index 4d5dc6f3a67a6a062bf204319796b7676a529da2..29de156cf67609c9cc88d604fafe710ef4058a5d 100644 --- a/create-libperl-soname.patch +++ b/create-libperl-soname.patch @@ -1,54 +1,60 @@ -From fe7ae3db489775f409b9284c5e81ce91ab8578da Mon Sep 17 00:00:00 2001 +From fa2f0dd5a7767223df10149d3f16d7ed7013e16f Mon Sep 17 00:00:00 2001 From: Torsten Veller -Date: Mon, 30 Dec 2019 15:10:30 +0800 -Subject: [PATCH] create libperl soname +Date: Sat, 14 Apr 2012 13:49:18 +0200 +Subject: Set libperl soname -See details: https://bugs.gentoo.org/286840 +Bug-Gentoo: https://bugs.gentoo.org/286840 +Patch-Name: gentoo/create_libperl_soname.diff --- - Makefile.SH | 8 +++++++- - 1 file changed, 7 insertions(+), 1 deletion(-) + Makefile.SH | 9 +++++++-- + 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/Makefile.SH b/Makefile.SH -index 123903d..e73f0ec 100755 +index 3f1851d..ac2903b 100755 --- a/Makefile.SH +++ b/Makefile.SH -@@ -68,7 +68,7 @@ true) - ${api_revision}.${api_version}.${api_subversion} \ - -current_version \ - ${revision}.${patchlevel}.${subversion} \ -- -install_name \$(shrpdir)/\$@" -+ -install_name \$(shrpdir)/libperl.${revision}.${patchlevel}.dylib" +@@ -70,11 +70,11 @@ true) + ${revision}.${patchlevel}.${subversion}" + case "$osvers" in + 1[5-9]*|[2-9]*) +- shrpldflags="$shrpldflags -install_name `pwd`/\$@ -Xlinker -headerpad_max_install_names" ++ shrpldflags="$shrpldflags -install_name `pwd`/libperl.${revision}.${patchlevel}.dylib -Xlinker -headerpad_max_install_names" + exeldflags="-Xlinker -headerpad_max_install_names" + ;; + *) +- shrpldflags="$shrpldflags -install_name \$(shrpdir)/\$@" ++ shrpldflags="$shrpldflags -install_name \$(shrpdir)/libperl.${revision}.${patchlevel}.dylib" + ;; + esac ;; - cygwin*) - shrpldflags="$shrpldflags -Wl,--out-implib=libperl.dll.a -Wl,--image-base,0x52000000" -@@ -76,13 +76,16 @@ true) +@@ -84,13 +84,15 @@ true) ;; sunos*) linklibperl="-lperl" -+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}" ++ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}" ;; netbsd*|freebsd[234]*|openbsd*|dragonfly*|bitrig*) linklibperl="-L. -lperl" -+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}" ++ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}" ;; interix*) linklibperl="-L. -lperl" - shrpldflags="$shrpldflags -Wl,--image-base,0x57000000" -+ shrpldflags="$shrpldflags -Wl,--image-base,0x57000000 -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}" +- shrpldflags="$shrpldflags -Wl,--image-base,0x57000000" ++ shrpldflags="$shrpldflags -Wl,--image-base,0x57000000 -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}" ;; aix*) case "$cc" in -@@ -120,6 +123,9 @@ true) +@@ -128,6 +130,9 @@ true) linklibperl='libperl.x' DPERL_EXTERNAL_GLOB='' ;; -+ linux*) -+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}" -+ ;; ++ linux*) ++ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}" ++ ;; esac case "$ldlibpthname" in '') ;; -- -1.8.3.1 +2.23.0 diff --git a/perl-132655-nul-terminate-result-of-unpack-u-of-inva.patch b/perl-132655-nul-terminate-result-of-unpack-u-of-inva.patch deleted file mode 100644 index 3f010984989dbf38c338856edda151bb2320bef1..0000000000000000000000000000000000000000 --- a/perl-132655-nul-terminate-result-of-unpack-u-of-inva.patch +++ /dev/null @@ -1,56 +0,0 @@ -From 12cad9bd99725bba72029e2651b2b7f0cab2e0b0 Mon Sep 17 00:00:00 2001 -From: Tony Cook -Date: Mon, 20 Aug 2018 16:31:45 +1000 -Subject: [PATCH] (perl #132655) nul terminate result of unpack "u" of invalid - data - -In the given test case, Perl_atof2() would run off the end of the PV, -producing an error from ASAN. ---- - pp_pack.c | 5 ++++- - t/op/pack.t | 9 ++++++++- - 2 files changed, 12 insertions(+), 2 deletions(-) - -diff --git a/pp_pack.c b/pp_pack.c -index 5e9cc64301..f8be9d48ae 100644 ---- a/pp_pack.c -+++ b/pp_pack.c -@@ -1727,7 +1727,10 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c - if (!checksum) { - const STRLEN l = (STRLEN) (strend - s) * 3 / 4; - sv = sv_2mortal(newSV(l)); -- if (l) SvPOK_on(sv); -+ if (l) { -+ SvPOK_on(sv); -+ *SvEND(sv) = '\0'; -+ } - } - - /* Note that all legal uuencoded strings are ASCII printables, so -diff --git a/t/op/pack.t b/t/op/pack.t -index cf0e286509..bb9f865091 100644 ---- a/t/op/pack.t -+++ b/t/op/pack.t -@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' : - my $no_signedness = $] > 5.009 ? '' : - "Signed/unsigned pack modifiers not available on this perl"; - --plan tests => 14717; -+plan tests => 14718; - - use strict; - use warnings qw(FATAL all); -@@ -2081,3 +2081,10 @@ SKIP: - fresh_perl_like('pack "c10f1073741824"', qr/Out of memory during pack/, { stderr => 1 }, - "integer overflow calculating allocation (multiply)"); - } -+ -+{ -+ # [perl #132655] heap-buffer-overflow READ of size 11 -+ # only expect failure under ASAN (and maybe valgrind) -+ fresh_perl_is('0.0 + unpack("u", "ab")', "", { stderr => 1 }, -+ "ensure unpack u of invalid data nul terminates result"); -+} --- -2.19.1 - diff --git a/perl-133314-always-close-the-directory-handle-on-cle.patch b/perl-133314-always-close-the-directory-handle-on-cle.patch deleted file mode 100644 index eb1c20109a6ffda343ddaa48d6697d8ffbc9ce01..0000000000000000000000000000000000000000 --- a/perl-133314-always-close-the-directory-handle-on-cle.patch +++ /dev/null @@ -1,97 +0,0 @@ -From 3d5e9c119db6b727684fe75dfcfe5831c4351bec Mon Sep 17 00:00:00 2001 -From: Tony Cook -Date: Mon, 2 Jul 2018 10:43:19 +1000 -Subject: [PATCH] (perl #133314) always close the directory handle on clean up - -Previously the directory handle was only closed if the rest of the -magic free clean up is done, but in most success cases that code -doesn't run, leaking the directory handle. - -So always close the directory if our AV is available. ---- - doio.c | 56 +++++++++++++++++++++++++++++++------------------------- - 1 file changed, 31 insertions(+), 25 deletions(-) - -diff --git a/doio.c b/doio.c -index 4b8923f77c..16daf9fd11 100644 ---- a/doio.c -+++ b/doio.c -@@ -1163,44 +1163,50 @@ S_argvout_free(pTHX_ SV *io, MAGIC *mg) { - - /* mg_obj can be NULL if a thread is created with the handle open, in which - case we leave any clean up to the parent thread */ -- if (mg->mg_obj && IoIFP(io)) { -- SV **pid_psv; -+ if (mg->mg_obj) { - #ifdef ARGV_USE_ATFUNCTIONS - SV **dir_psv; - DIR *dir; -+ -+ dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE); -+ assert(dir_psv && *dir_psv && SvIOK(*dir_psv)); -+ dir = INT2PTR(DIR *, SvIV(*dir_psv)); - #endif -- PerlIO *iop = IoIFP(io); -+ if (IoIFP(io)) { -+ SV **pid_psv; -+ PerlIO *iop = IoIFP(io); - -- assert(SvTYPE(mg->mg_obj) == SVt_PVAV); -+ assert(SvTYPE(mg->mg_obj) == SVt_PVAV); - -- pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE); -+ pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE); - -- assert(pid_psv && *pid_psv); -+ assert(pid_psv && *pid_psv); - -- if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) { -- /* if we get here the file hasn't been closed explicitly by the -- user and hadn't been closed implicitly by nextargv(), so -- abandon the edit */ -- SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE); -- const char *temp_pv = SvPVX(*temp_psv); -+ if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) { -+ /* if we get here the file hasn't been closed explicitly by the -+ user and hadn't been closed implicitly by nextargv(), so -+ abandon the edit */ -+ SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE); -+ const char *temp_pv = SvPVX(*temp_psv); - -- assert(temp_psv && *temp_psv && SvPOK(*temp_psv)); -- (void)PerlIO_close(iop); -- IoIFP(io) = IoOFP(io) = NULL; -+ assert(temp_psv && *temp_psv && SvPOK(*temp_psv)); -+ (void)PerlIO_close(iop); -+ IoIFP(io) = IoOFP(io) = NULL; - #ifdef ARGV_USE_ATFUNCTIONS -- dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE); -- assert(dir_psv && *dir_psv && SvIOK(*dir_psv)); -- dir = INT2PTR(DIR *, SvIV(*dir_psv)); -- if (dir) { -- if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 && -- NotSupported(errno)) -- (void)UNLINK(temp_pv); -- closedir(dir); -- } -+ if (dir) { -+ if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 && -+ NotSupported(errno)) -+ (void)UNLINK(temp_pv); -+ } - #else -- (void)UNLINK(temp_pv); -+ (void)UNLINK(temp_pv); - #endif -+ } - } -+#ifdef ARGV_USE_ATFUNCTIONS -+ if (dir) -+ closedir(dir); -+#endif - } - - return 0; --- -2.19.1 - diff --git a/perl-5.28.0.tar.xz b/perl-5.28.3.tar.xz similarity index 59% rename from perl-5.28.0.tar.xz rename to perl-5.28.3.tar.xz index 9ea8f3c183055079f9e7861b3248e6e869b803d4..ec36947990a6cd5221d6ece926845e0d96a2e60c 100644 Binary files a/perl-5.28.0.tar.xz and b/perl-5.28.3.tar.xz differ diff --git a/perl.spec b/perl.spec index b99a991a25eebf364200286d9e98967f81cf6881..c8ce9516cf56e9d116fd8af9204afeac70d20ee9 100644 --- a/perl.spec +++ b/perl.spec @@ -17,8 +17,8 @@ Name: perl License: (GPL+ or Artistic) and (GPLv2+ or Artistic) and MIT and UCD and Public Domain and BSD Epoch: 4 -Version: 5.28.0 -Release: 435 +Version: 5.28.3 +Release: 1 Summary: A highly capable, feature-rich programming language Url: https://www.perl.org/ Source0: https://www.cpan.org/src/5.0/%{name}-%{version}.tar.xz @@ -33,44 +33,28 @@ Patch5: create-libperl-soname.patch Patch8: perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch # PATCH-FIX-OPENEULER--RT#133295 Patch12: delete-ext-GDBM_File-t-fatal.t.patch -# PATCH-FIX-UPSTREAM--RT#133204, upstream 5.29.0 -Patch13: Perl_my_setenv-handle-integer-wrap.patch # PATCH-FIX-UPSTREAM-- upstream 5.29.0 Patch14: regexec.c-Call-macro-with-correct-args.patch # PATCH-FIX-UPSTREAM-- upstream 5.29.0 Patch15: perl.h-Add-parens-around-macro-arguments.patch -# PATCH-FIX-UPSTREAM--RT#133368, upstream 5.29.0 -Patch16: treat-when-index-1-as-a-boolean-expression.patch # PATCH-FIX-UPSTREAM-- upstream 5.29.0 Patch17: locale.c-Fix-conditional-compilation.patch # PATCH-FIX-UPSTREAM--RT#133314, upstream 5.29.1 Patch18: perl-133314-test-for-handle-leaks-from-in-place-edit.patch -Patch19: perl-133314-always-close-the-directory-handle-on-cle.patch # PATCH-FIX-UPSTREAM--Fix buffer overrun, upstream 5.29.1 Patch20: utf8.c-Make-safer-a-deprecated-function.patch # PATCH-FIX-UPSTREAM--Fix time race, upstream 5.29.1 Patch21: Time-HiRes-t-itimer.t-avoid-race-condition.patch # PATCH-FIX-UPSTREAM-- upstream 5.29.1 -Patch22: Fix-script-run-bug-1-followed-by-Thai-digit.patch -# PATCH-FIX-UPSTREAM-- upstream 5.29.1 Patch23: Update-Time-Piece-to-CPAN-version-1.33.patch # PATCH-FIX-UPSTREAM-- RT#133441, upstream 5.29.2 Patch24: multiconcat-mutator-not-seen-in-lex.patch # PATCH-FIX-UPSTREAM-- RT#132683, upstream 5.29.2 Patch25: perl-132683-don-t-try-to-convert-PL_sv_placeholder-i.patch -# PATCH-FIX-UPSTREAM-- RT#132655, upstream 5.29.2 -Patch26: perl-132655-nul-terminate-result-of-unpack-u-of-inva.patch # PATCH-FIX-OPENEULER # In 2020, a year of 70 starts to mean 2070. So cpan/Time-Local/t/Local.t test Patch27: Fix-time-local-tests-in-2020.patch -Patch6000: CVE-2018-18312-1.patch -Patch6001: CVE-2018-18312-2.patch -Patch6002: CVE-2018-18312-3.patch -Patch6003: backport-CVE-2020-10543.patch -Patch6004: backport-CVE-2020-10878.patch -Patch6005: backport-CVE-2020-12723.patch - BuildRequires: gcc bash findutils coreutils make tar procps bzip2-devel gdbm-devel BuildRequires: zlib-devel systemtap-sdt-devel perl-interpreter perl-generators gdb @@ -514,6 +498,12 @@ make test_harness %{_mandir}/man3/* %changelog +* Thu Aug 13 2020 openEuler Buildteam - 4:5.28.3-1 +- Type:enhancement +- ID:NA +- SUG:NA +- DESC:update version to 5.28.3 + * Mon Aug 3 2020 wenzhanli - 4:5.28.0-435 - Type:bugfix - ID:NA diff --git a/perl.yaml b/perl.yaml deleted file mode 100644 index d7552e2080d7d3eda2924f7fdda1d2643b09164f..0000000000000000000000000000000000000000 --- a/perl.yaml +++ /dev/null @@ -1,4 +0,0 @@ -version_control: github -src_repo: Perl/perl5 -tag_prefix: ^v -seperator: . diff --git a/treat-when-index-1-as-a-boolean-expression.patch b/treat-when-index-1-as-a-boolean-expression.patch deleted file mode 100644 index 4f75f2c5aae54fef0cab03b8cc35685475105402..0000000000000000000000000000000000000000 --- a/treat-when-index-1-as-a-boolean-expression.patch +++ /dev/null @@ -1,98 +0,0 @@ -From 6b877bbd2c071b3e0659fab552a74dc2ff7e08fb Mon Sep 17 00:00:00 2001 -From: David Mitchell -Date: Sat, 14 Jul 2018 10:47:04 +0100 -Subject: [PATCH] treat when(index() > -1) as a boolean expression - -RT #133368 - -when(X) is normally compiled as when($_ ~~ X) *except* when X appears to -be a boolean expression, in which case it's used directly. - -5.28.0 introduced an optimisation whereby comparisons involving index -like - - index(...) != -1 - -eliminated the comparison, and pp_index() returned a boolean value -directly. This defeated the 'look for a boolean op' mechanism, and so - - when(index(...) != -1) - -and similar were being incorrectly compiled as - - when($_ ~~ (index(...) != -1)) ---- - op.c | 8 +++++++- - t/op/switch.t | 23 ++++++++++++++++++++++- - 2 files changed, 29 insertions(+), 2 deletions(-) - -diff --git a/op.c b/op.c -index a05a1319d4..ddeb484b64 100644 ---- a/op.c -+++ b/op.c -@@ -9072,6 +9072,13 @@ S_looks_like_bool(pTHX_ const OP *o) - case OP_FLOP: - - return TRUE; -+ -+ case OP_INDEX: -+ case OP_RINDEX: -+ /* optimised-away (index() != -1) or similar comparison */ -+ if (o->op_private & OPpTRUEBOOL) -+ return TRUE; -+ return FALSE; - - case OP_CONST: - /* Detect comparisons that have been optimized away */ -@@ -9081,7 +9088,6 @@ S_looks_like_bool(pTHX_ const OP *o) - return TRUE; - else - return FALSE; -- - /* FALLTHROUGH */ - default: - return FALSE; -diff --git a/t/op/switch.t b/t/op/switch.t -index e5385df0b4..6ff69e0bce 100644 ---- a/t/op/switch.t -+++ b/t/op/switch.t -@@ -10,7 +10,7 @@ use strict; - use warnings; - no warnings 'experimental::smartmatch'; - --plan tests => 195; -+plan tests => 197; - - # The behaviour of the feature pragma should be tested by lib/feature.t - # using the tests in t/lib/feature/*. This file tests the behaviour of -@@ -1358,6 +1358,27 @@ given("xyz") { - "scalar value of false when"; - } - -+# RT #133368 -+# index() and rindex() comparisons such as '> -1' are optimised away. Make -+# sure that they're still treated as a direct boolean expression rather -+# than when(X) being implicitly converted to when($_ ~~ X) -+ -+{ -+ my $s = "abc"; -+ my $ok = 0; -+ given("xyz") { -+ when (index($s, 'a') > -1) { $ok = 1; } -+ } -+ ok($ok, "RT #133368 index"); -+ -+ $ok = 0; -+ given("xyz") { -+ when (rindex($s, 'a') > -1) { $ok = 1; } -+ } -+ ok($ok, "RT #133368 rindex"); -+} -+ -+ - # Okay, that'll do for now. The intricacies of the smartmatch - # semantics are tested in t/op/smartmatch.t. Taintedness of - # returned values is checked in t/op/taint.t. --- -2.19.1 -