rpms/perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity

re-import sources as agreed with the maintainer

Browse Source
This commit is contained in:
Adam Samalik 2023-06-30 07:43:29 +02:00
parent 2a9d30bd5c
commit ba31523363
53 changed files with 35 additions and 3057 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
.gitignore vendored
View File

@ -1,2 +1,34 @@
SOURCES/perl-5.30.1.tar.xz
perl-5.12.1.tar.gz
/perl-5.12.2.tar.gz
/perl-5.12.3.tar.gz
/perl-5.14.0-RC2.tar.bz2
/perl-5.14.0.tar.bz2
/perl-5.14.0.tar.gz
/perl-5.14.1.tar.gz
/perl-5.14.2.tar.bz2
/perl-5.16.0-RC2.tar.gz
/perl-5.16.0.tar.gz
/perl-5.16.1-228.fc19.src.rpm
/perl-5.16.1.tar.gz
/perl-5.16.2.tar.gz
/perl-5.16.3.tar.bz2
/perl-5.18.0.tar.bz2
/perl-5.18.1.tar.bz2
/perl-5.18.2.tar.bz2
/perl-5.20.0.tar.bz2
/perl-5.20.1.tar.bz2
/perl-5.20.2.tar.bz2
/perl-5.22.0.tar.bz2
/perl-5.22.1.tar.bz2
/perl-5.22.2.tar.bz2
/perl-5.24.0.tar.bz2
/perl-5.24.1.tar.bz2
/perl-5.26.0.tar.bz2
/perl-5.26.1.tar.bz2
/perl-5.26.2-RC1.tar.bz2
/perl-5.26.2.tar.bz2
/perl-5.28.0.tar.xz
/perl-5.28.1.tar.xz
/perl-5.28.2.tar.xz
/perl-5.30.0.tar.xz
/perl-5.30.1.tar.xz

0
checkemptydirs Executable file → Normal file
View File

0
checkpackageversion Executable file → Normal file
View File

0
diffrpms Executable file → Normal file
View File

10
gating.yaml
View File

@ -1,10 +0,0 @@
--- !Policy
product_versions:
- rhel-9
decision_context: osci_compose_gate
rules:
- !PassingTestCaseRule {test_case_name: baseos-ci.brew-build.acceptance-tier.functional}
- !PassingTestCaseRule {test_case_name: baseos-ci.brew-build.tier1.functional}
- !PassingTestCaseRule {test_case_name: baseos-ci.brew-build.tier2.functional}
- !PassingTestCaseRule {test_case_name: baseos-ci.brew-build.tier3.functional}
- !PassingTestCaseRule {test_case_name: baseos-ci.brew-build.tiers-no-perlcore.functional}

0
generatedependencies Executable file → Normal file
View File

175
perl-5.32.0-Add-av_count.patch
View File

@ -1,175 +0,0 @@
From bafffe7f2ca587960177ed03216e2d5692fe6143 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Wed, 19 Aug 2020 11:57:17 -0600
Subject: [PATCH] Add av_count()
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This returns the number of elements in an array in a clearly named
function.
av_top_index(), av_tindex() are clearly named, but are less than ideal,
and came about because no one back then thought of this one, until now
Paul Evans did.
Petr Písař: Port 87306e0674dfe3af29804b4641347cd5ac9b0521 to 5.32.0.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
av.c | 17 ++++++++++++++---
av.h | 3 ++-
embed.fnc | 3 ++-
embed.h | 2 +-
inline.h | 16 ++++++++++++----
proto.h | 11 ++++++++---
6 files changed, 39 insertions(+), 13 deletions(-)
diff --git a/av.c b/av.c
index 27b2f12..b5ddaca 100644
--- a/av.c
+++ b/av.c
@@ -814,9 +814,10 @@ The Perl equivalent for this is C<$#myarray>.
=for apidoc av_len
Same as L</av_top_index>. Note that, unlike what the name implies, it returns
-the highest index in the array, so to get the size of the array you need to use
-S<C<av_len(av) + 1>>. This is unlike L</sv_len>, which returns what you would
-expect.
+the highest index in the array. This is unlike L</sv_len>, which returns what
+you would expect.
+
+B<To get the true number of elements in the array, instead use C<L</av_count>>>.
=cut
*/
@@ -1089,6 +1090,16 @@ Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
return sv;
}
+SSize_t
+Perl_av_top_index(pTHX_ AV *av)
+{
+ PERL_ARGS_ASSERT_AV_TOP_INDEX;
+ assert(SvTYPE(av) == SVt_PVAV);
+
+ return AvFILL(av);
+}
+
+
/*
* ex: set ts=8 sts=4 sw=4 et:
*/
diff --git a/av.h b/av.h
index 5e39c42..90ebfff 100644
--- a/av.h
+++ b/av.h
@@ -81,7 +81,8 @@ Same as C<av_top_index()>.
#define AvFILL(av) ((SvRMAGICAL((const SV *) (av))) \
? mg_size(MUTABLE_SV(av)) : AvFILLp(av))
-#define av_tindex(av) av_top_index(av)
+#define av_top_index(av) AvFILL(av)
+#define av_tindex(av) av_top_index(av)
/* Note that it doesn't make sense to do this:
* SvGETMAGIC(av); IV x = av_tindex_nomg(av);
diff --git a/embed.fnc b/embed.fnc
index 589ab1a..789cd3c 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -541,7 +541,8 @@ Apd |void |av_push |NN AV *av|NN SV *val
EXp |void |av_reify |NN AV *av
ApdR |SV* |av_shift |NN AV *av
Apd |SV** |av_store |NN AV *av|SSize_t key|NULLOK SV *val
-AidRp |SSize_t|av_top_index |NN AV *av
+AMdRp |SSize_t|av_top_index |NN AV *av
+AidRp |Size_t |av_count |NN AV *av
AmdR |SSize_t|av_tindex |NN AV *av
Apd |void |av_undef |NN AV *av
Apdoex |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val
diff --git a/embed.h b/embed.h
index 182b12a..329ac40 100644
--- a/embed.h
+++ b/embed.h
@@ -48,6 +48,7 @@
#define atfork_lock Perl_atfork_lock
#define atfork_unlock Perl_atfork_unlock
#define av_clear(a) Perl_av_clear(aTHX_ a)
+#define av_count(a) Perl_av_count(aTHX_ a)
#define av_delete(a,b,c) Perl_av_delete(aTHX_ a,b,c)
#define av_exists(a,b) Perl_av_exists(aTHX_ a,b)
#define av_extend(a,b) Perl_av_extend(aTHX_ a,b)
@@ -59,7 +60,6 @@
#define av_push(a,b) Perl_av_push(aTHX_ a,b)
#define av_shift(a) Perl_av_shift(aTHX_ a)
#define av_store(a,b,c) Perl_av_store(aTHX_ a,b,c)
-#define av_top_index(a) Perl_av_top_index(aTHX_ a)
#define av_undef(a) Perl_av_undef(aTHX_ a)
#define av_unshift(a,b) Perl_av_unshift(aTHX_ a,b)
#define block_end(a,b) Perl_block_end(aTHX_ a,b)
diff --git a/inline.h b/inline.h
index 27005d2..35af18a 100644
--- a/inline.h
+++ b/inline.h
@@ -39,13 +39,21 @@ SOFTWARE.
/* ------------------------------- av.h ------------------------------- */
-PERL_STATIC_INLINE SSize_t
-Perl_av_top_index(pTHX_ AV *av)
+/*
+=for apidoc av_count
+Returns the number of elements in the array C<av>. This is the true length of
+the array, including any undefined elements. It is always the same as
+S<C<av_top_index(av) + 1>>.
+
+=cut
+*/
+PERL_STATIC_INLINE Size_t
+Perl_av_count(pTHX_ AV *av)
{
- PERL_ARGS_ASSERT_AV_TOP_INDEX;
+ PERL_ARGS_ASSERT_AV_COUNT;
assert(SvTYPE(av) == SVt_PVAV);
- return AvFILL(av);
+ return AvFILL(av) + 1;
}
/* ------------------------------- cv.h ------------------------------- */
diff --git a/proto.h b/proto.h
index 02ef4ed..83ba098 100644
--- a/proto.h
+++ b/proto.h
@@ -219,6 +219,13 @@ PERL_CALLCONV SV** Perl_av_arylen_p(pTHX_ AV *av);
PERL_CALLCONV void Perl_av_clear(pTHX_ AV *av);
#define PERL_ARGS_ASSERT_AV_CLEAR \
assert(av)
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE Size_t Perl_av_count(pTHX_ AV *av)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_AV_COUNT \
+ assert(av)
+#endif
+
PERL_CALLCONV void Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val);
#define PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH \
assert(avp); assert(val)
@@ -284,12 +291,10 @@ PERL_CALLCONV SV** Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val);
__attribute__warn_unused_result__; */
#define PERL_ARGS_ASSERT_AV_TINDEX
-#ifndef PERL_NO_INLINE_FUNCTIONS
-PERL_STATIC_INLINE SSize_t Perl_av_top_index(pTHX_ AV *av)
+PERL_CALLCONV SSize_t Perl_av_top_index(pTHX_ AV *av)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_AV_TOP_INDEX \
assert(av)
-#endif
PERL_CALLCONV void Perl_av_undef(pTHX_ AV *av);
#define PERL_ARGS_ASSERT_AV_UNDEF \
--
2.25.4

49
perl-5.32.0-Fix-404-and-text-in-New-Unicode-properties-section.patch
View File

@ -1,49 +0,0 @@
From b0d826f28ae47d22229949e754709e68afe5d83d Mon Sep 17 00:00:00 2001
From: raiph <raiph.mellor@gmail.com>
Date: Thu, 2 Jul 2020 17:30:07 +0100
Subject: [PATCH] Fix 404 and text in New Unicode properties section
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
See https://github.com/Perl/perl5/issues/17881
I found a 404, and an "old" link. I investigated.
My conclusion was UC have landed new TR18 and TR39 since text in section
New Unicode properties Identifier_Status and Identifier_Type supported
was written.
I've guessed at a suitable update.
Petr Písař: Ported from e02f7c069a8e7dd98b0ec010e9b3c6619b46baf3
upstream commmit.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pod/perldelta.pod | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index b92ea53..bb3d1ef 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -48,12 +48,12 @@ L<perlop/Operator Precedence and Associativity>.
=head2 New Unicode properties C<Identifier_Status> and C<Identifier_Type> supported
-Unicode is in the process of revising its regular expression
-requirements: L<https://www.unicode.org/draft/reports/tr18/tr18.html>.
+Unicode has revised its regular expression requirements:
+L<https://www.unicode.org/reports/tr18/tr18-21.html>.
As part of that they are wanting more properties to be exposed, ones
that aren't part of the strict UCD (Unicode character database). These
two are used for examining inputs for security purposes. Details on
-their usage is at L<https://www.unicode.org/reports/tr39/proposed.html>.
+their usage is at L<https://www.unicode.org/reports/tr39/>.
=head2 It is now possible to write C<qr/\p{Name=...}/>, or
C<qr!\p{na=/(SMILING|GRINNING) FACE/}!>
--
2.25.4

196
perl-5.32.0-pp_split-no-SWITCHSTACK-in-ary-split-.-optimisation.patch
View File

@ -1,196 +0,0 @@
From d7504df2a5d8985f2a8b04f17acff5e324572c39 Mon Sep 17 00:00:00 2001
From: Richard Leach <richardleach@users.noreply.github.com>
Date: Sun, 11 Oct 2020 12:26:27 +0100
Subject: [PATCH] pp_split: no SWITCHSTACK in @ary = split(...) optimisation
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Petr Písař: 607eaf26a99ff76ab48877e68f1d7b005dc51575 ported to 5.32.0.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp.c | 89 +++++++++++++++++++++++++++++-----------------------
t/op/split.t | 23 +++++++++++++-
2 files changed, 72 insertions(+), 40 deletions(-)
diff --git a/pp.c b/pp.c
index df80830..e4863d3 100644
--- a/pp.c
+++ b/pp.c
@@ -5985,6 +5985,7 @@ PP(pp_split)
/* handle @ary = split(...) optimisation */
if (PL_op->op_private & OPpSPLIT_ASSIGN) {
+ realarray = 1;
if (!(PL_op->op_flags & OPf_STACKED)) {
if (PL_op->op_private & OPpSPLIT_LEX) {
if (PL_op->op_private & OPpLVAL_INTRO)
@@ -6007,26 +6008,10 @@ PP(pp_split)
oldsave = PL_savestack_ix;
}
- realarray = 1;
- PUTBACK;
- av_extend(ary,0);
- (void)sv_2mortal(SvREFCNT_inc_simple_NN(sv));
- av_clear(ary);
- SPAGAIN;
if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
- }
- else {
- if (!AvREAL(ary)) {
- I32 i;
- AvREAL_on(ary);
- AvREIFY_off(ary);
- for (i = AvFILLp(ary); i >= 0; i--)
- AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
- }
- /* temporarily switch stacks */
- SAVESWITCHSTACK(PL_curstack, ary);
+ } else {
make_mortal = 0;
}
}
@@ -6358,29 +6343,56 @@ PP(pp_split)
LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */
SPAGAIN;
if (realarray) {
- if (!mg) {
- if (SvSMAGICAL(ary)) {
- PUTBACK;
+ if (!mg) {
+ PUTBACK;
+ if(AvREAL(ary)) {
+ if (av_count(ary) > 0)
+ av_clear(ary);
+ } else {
+ AvREAL_on(ary);
+ AvREIFY_off(ary);
+
+ if (AvMAX(ary) > -1) {
+ /* don't free mere refs */
+ Zero(AvARRAY(ary), AvMAX(ary), SV*);
+ }
+ }
+ if(AvMAX(ary) < iters)
+ av_extend(ary,iters);
+ SPAGAIN;
+
+ /* Need to copy the SV*s from the stack into ary */
+ Copy(SP + 1 - iters, AvARRAY(ary), iters, SV*);
+ AvFILLp(ary) = iters - 1;
+
+ if (SvSMAGICAL(ary)) {
+ PUTBACK;
mg_set(MUTABLE_SV(ary));
SPAGAIN;
- }
- if (gimme == G_ARRAY) {
- EXTEND(SP, iters);
- Copy(AvARRAY(ary), SP + 1, iters, SV*);
- SP += iters;
- RETURN;
- }
+ }
+
+ if (gimme != G_ARRAY) {
+ /* SP points to the final SV* pushed to the stack. But the SV* */
+ /* are not going to be used from the stack. Point SP to below */
+ /* the first of these SV*. */
+ SP -= iters;
+ PUTBACK;
+ }
}
else {
- PUTBACK;
- ENTER_with_name("call_PUSH");
- call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
- LEAVE_with_name("call_PUSH");
- SPAGAIN;
+ PUTBACK;
+ av_extend(ary,iters);
+ av_clear(ary);
+
+ ENTER_with_name("call_PUSH");
+ call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
+ LEAVE_with_name("call_PUSH");
+ SPAGAIN;
+
if (gimme == G_ARRAY) {
SSize_t i;
/* EXTEND should not be needed - we just popped them */
- EXTEND(SP, iters);
+ EXTEND_SKIP(SP, iters);
for (i=0; i < iters; i++) {
SV **svp = av_fetch(ary, i, FALSE);
PUSHs((svp) ? *svp : &PL_sv_undef);
@@ -6389,13 +6401,12 @@ PP(pp_split)
}
}
}
- else {
- if (gimme == G_ARRAY)
- RETURN;
- }
- GETTARGET;
- XPUSHi(iters);
+ if (gimme != G_ARRAY) {
+ GETTARGET;
+ XPUSHi(iters);
+ }
+
RETURN;
}
diff --git a/t/op/split.t b/t/op/split.t
index 14f9158..7f37512 100644
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -7,7 +7,7 @@ BEGIN {
set_up_inc('../lib');
}
-plan tests => 176;
+plan tests => 182;
$FS = ':';
@@ -648,6 +648,19 @@ is "@a", '1 2 3', 'assignment to split-to-array (stacked)';
is (+@a, 0, "empty utf8 string");
}
+# correct stack adjustments (gh#18232)
+{
+ sub foo { return @_ }
+ my @a = foo(1, scalar split " ", "a b");
+ is(join('', @a), "12", "Scalar split to a sub parameter");
+}
+
+{
+ sub foo { return @_ }
+ my @a = foo(1, scalar(@x = split " ", "a b"));
+ is(join('', @a), "12", "Split to @x then use scalar result as a sub parameter");
+}
+
fresh_perl_is(<<'CODE', '', {}, "scalar split stack overflow");
map{int"";split//.0>60for"0000000000000000"}split// for"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
CODE
@@ -667,3 +680,11 @@ CODE
ok(eq_array(\@result,['a','b']), "Resulting in ('a','b')");
}
}
+
+# check that the (@ary = split) optimisation survives @ary being modified
+
+fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");',
+ '',{},'(@ary = split ...) survives @ary being Renew()ed');
+fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");',
+ '',{},'(@ary = split ...) survives an (undef @ary)');
+
--
2.25.4

34
perl-5.32.1-DynaLoader-use-PerlEnv_getenv.patch
View File

@ -1,34 +0,0 @@
From ab72b7bd043df0f0ad6090a4c95f378624fad9fc Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sat, 7 Mar 2020 12:54:19 -0700
Subject: [PATCH] DynaLoader: use PerlEnv_getenv()
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Doing so invokes thread-safe guards
Petr Písař: Ported from b0312014d6c1804920d2b687a5fa5645b445ce9f to
5.32.1.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/DynaLoader/dlutils.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 8584f89..1a27fbd 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -115,7 +115,7 @@ dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
#endif
#if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS)
- if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL
+ if ( (perl_dl_nonlazy = PerlEnv_getenv("PERL_DL_NONLAZY")) != NULL
&& grok_atoUV(perl_dl_nonlazy, &uv, NULL)
&& uv <= INT_MAX
) {
--
2.26.2

44
perl-5.32.1-Perl_do_sv_dump-handle-PL_strtab.patch
View File

@ -1,44 +0,0 @@
From 2ce7bf1ad5fd7aee21975b3dd1c8dceef3aab7e4 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 9 Mar 2021 16:42:11 +0000
Subject: [PATCH] Perl_do_sv_dump(): handle PL_strtab
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
When dumping this special hash, the values in the HE entry are refcounts
rather than SV pointers. sv_dump() used to crash here.
Petr Písař: Ported to 5.32.1 from upstream
a9bb6a62ae45bb372a5cca98a76d1a79edd89ccb.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dump.c | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/dump.c b/dump.c
index f03c3f6..0f15d77 100644
--- a/dump.c
+++ b/dump.c
@@ -2224,8 +2224,15 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
if (HvEITER_get(hv) == he)
PerlIO_printf(file, "[CURRENT] ");
- PerlIO_printf(file, "HASH = 0x%" UVxf "\n", (UV) hash);
- do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
+ PerlIO_printf(file, "HASH = 0x%" UVxf, (UV) hash);
+
+ if (sv == (SV*)PL_strtab)
+ PerlIO_printf(file, " REFCNT = 0x%" UVxf "\n",
+ (UV)he->he_valu.hent_refcount );
+ else {
+ (void)PerlIO_putc(file, '\n');
+ do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
+ }
}
}
DONEHV:;
--
2.26.3

53
perl-5.32.1-hv.c-add-a-guard-clause-to-prevent-the-number-of-buc.patch
View File

@ -1,53 +0,0 @@
From c5eed6e541fe27d9e9dfd31f42c43f4dfa1f486b Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Sat, 11 Jul 2020 09:26:21 +0200
Subject: [PATCH] hv.c: add a guard clause to prevent the number of buckets in
a hash from getting too large
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This caps it at 1<<28 buckets, eg, ~268M. In theory without a guard clause like
this we could grow to the point of possibly wrapping around in terms of size,
not to mention being ridiculously wasteful of memory at larger sizes.
Even this cap is probably too high. It should probably be something like 1<<24.
Petr Písař: Ported to 5.32.1 from
aae087f7cec022be14a17deb95cb2208e16b7891.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
hv.c | 10 +++++++++-
1 file changed, 9 insertions(+), 1 deletion(-)
diff --git a/hv.c b/hv.c
index eccae62..32dbd19 100644
--- a/hv.c
+++ b/hv.c
@@ -38,7 +38,13 @@ holds the key and hash value.
* NOTE if you change this formula so we split earlier than previously
* you MUST change the logic in hv_ksplit()
*/
-#define DO_HSPLIT(xhv) ( ((xhv)->xhv_keys + ((xhv)->xhv_keys >> 1)) > (xhv)->xhv_max )
+
+/* MAX_BUCKET_MAX is the maximum max bucket index, at which point we stop growing the
+ * number of buckets,
+ */
+#define MAX_BUCKET_MAX ((1<<26)-1)
+#define DO_HSPLIT(xhv) ( ( ((xhv)->xhv_keys + ((xhv)->xhv_keys >> 1)) > (xhv)->xhv_max ) && \
+ ((xhv)->xhv_max < MAX_BUCKET_MAX) )
#define HV_FILL_THRESHOLD 31
static const char S_strtab_error[]
@@ -1426,6 +1432,8 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize)
);
PERL_ARGS_ASSERT_HSPLIT;
+ if (newsize > MAX_BUCKET_MAX+1)
+ return;
PL_nomemok = TRUE;
Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
--
2.26.2

30
perl-5.33.0-Add-missing-MANIFEST-entry-from-fix-for-debugger.patch
View File

@ -1,30 +0,0 @@
From 3c53c6179afbdbef748c110abdb849cb463c2727 Mon Sep 17 00:00:00 2001
From: Todd Rinaldo <toddr@cpan.org>
Date: Thu, 30 Jul 2020 17:42:47 -0500
Subject: [PATCH] Add missing MANIFEST entry from fix for debugger
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Add on fix to #17901
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
1 file changed, 1 insertion(+)
diff --git a/MANIFEST b/MANIFEST
index 990a75ad52..12601e46b4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4826,6 +4826,7 @@ lib/perl5db/t/symbol-table-bug Tests for the Perl debugger
lib/perl5db/t/taint Tests for the Perl debugger
lib/perl5db/t/test-a-statement-1 Tests for the Perl debugger
lib/perl5db/t/test-a-statement-2 Tests for the Perl debugger
+lib/perl5db/t/test-a-statement-3 Tests for the Perl debugger
lib/perl5db/t/test-dieLevel-option-1 Tests for the Perl debugger
lib/perl5db/t/test-frame-option-1 Tests for the Perl debugger
lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger
--
2.25.4

90
perl-5.33.0-After-running-an-action-in-the-debugger-turn-it-off.patch
View File

@ -1,90 +0,0 @@
From b248789b64d6bd277c52bfe608ed3192023af1bd Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Fri, 26 Jun 2020 21:19:24 +0200
Subject: [PATCH] After running an action in the debugger, turn it off
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
When running with "c", there was no problem, but when running with "n"
or "s", once the action was executed, it kept executing on the
following lines, which wasn't expected. Clearing $action here prevents
this unwanted behaviour.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/perl5db.pl | 3 ++-
lib/perl5db.t | 22 ++++++++++++++++++++++
lib/perl5db/t/test-a-statement-3 | 6 ++++++
3 files changed, 30 insertions(+), 1 deletion(-)
create mode 100644 lib/perl5db/t/test-a-statement-3
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 69a9bb6e64..e04a0e17fa 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -529,7 +529,7 @@ BEGIN {
use vars qw($VERSION $header);
# bump to X.XX in blead, only use X.XX_XX in maint
-$VERSION = '1.57';
+$VERSION = '1.58';
$header = "perl5db.pl version $VERSION";
@@ -2708,6 +2708,7 @@ If there are any preprompt actions, execute those as well.
# The &-call is here to ascertain the mutability of @_.
&DB::eval;
}
+ undef $action;
# Are we nested another level (e.g., did we evaluate a function
# that had a breakpoint in it at the debugger prompt)?
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 421229a54a..913a301d98 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -2799,6 +2799,28 @@ SKIP:
);
}
+{
+ # GitHub #17901
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'a 4 $s++',
+ ('s') x 5,
+ 'x $s',
+ 'q'
+ ],
+ prog => '../lib/perl5db/t/test-a-statement-3',
+ switches => [ '-d' ],
+ stderr => 0,
+ }
+ );
+ $wrapper->contents_like(
+ qr/^0 +2$/m,
+ 'Test that the a command runs only on the given lines.',
+ );
+}
+
{
# perl 5 RT #126735 regression bug.
local $ENV{PERLDB_OPTS} = "NonStop=0 RemotePort=non-existent-host.tld:9001";
diff --git a/lib/perl5db/t/test-a-statement-3 b/lib/perl5db/t/test-a-statement-3
new file mode 100644
index 0000000000..b188c1c5c5
--- /dev/null
+++ b/lib/perl5db/t/test-a-statement-3
@@ -0,0 +1,6 @@
+use strict; use warnings;
+
+for my $x (1 .. 2) {
+ my $y = $x + 1;
+ my $x = $x - 1;
+}
--
2.25.4

33
perl-5.33.0-Clearing-DB-action-at-the-end-is-no-longer-needed.patch
View File

@ -1,33 +0,0 @@
From 589464a875768e4b4a609d972488e3b592103097 Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Mon, 27 Jul 2020 11:32:51 +0200
Subject: [PATCH] Clearing DB::action at the end is no longer needed
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
as it's cleared right after it's been run.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/perl5db.pl | 4 ----
1 file changed, 4 deletions(-)
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index e04a0e17fa..af3b972da0 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -3347,10 +3347,6 @@ use B<o> I<inhibit_exit> to avoid stopping after program termination,
B<h q>, B<h R> or B<h o> to get additional info.
EOP
- # Set the DB::eval context appropriately.
- # At program termination disable any user actions.
- $DB::action = undef;
-
$DB::package = 'main';
$DB::usercontext = DB::_calc_usercontext($DB::package);
} ## end elsif ($package eq 'DB::fake')
--
2.25.4

31
perl-5.33.0-Fix-leak-GH-18054.patch
View File

@ -1,31 +0,0 @@
From 6841cd5977c2d35ad75233734c66983a65613fce Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Wed, 12 Aug 2020 17:53:52 -0600
Subject: [PATCH] Fix leak GH #18054
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This was a simple matter of one path failing to free the memory.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 2 ++
1 file changed, 2 insertions(+)
diff --git a/regcomp.c b/regcomp.c
index addf375450..01f297c299 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -15191,6 +15191,8 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
FAIL2("panic: loc_correspondence[%d] is 0",
(int) (s - s_start));
}
+ Safefree(locfold_buf);
+ Safefree(loc_correspondence);
}
else {
upper_fill = s - s0;
--
2.25.4

74
perl-5.33.0-IO-Handle-Fix-a-spurious-error-reported-for-regular-.patch
View File

@ -1,74 +0,0 @@
From 8a2562bec7cd9f8eff6812f340f99dddd028bb33 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Thu, 6 Aug 2020 10:51:56 +0200
Subject: [PATCH] IO::Handle: Fix a spurious error reported for regular file
handles
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
89341f87 fix for GH #6799 introduced a regression when calling error()
on an IO::Handle object that was opened for reading a regular file:
$ perl -e 'open my $f, q{<}, q{/etc/hosts} or die; print qq{error\n} if $f->error'
error
In case of a regular file opened for reading, IoOFP() returns NULL and
PerlIO_error(NULL) reports -1. Compare to the case of a file opened
for writing when both IoIFP() and IoOFP() return non-NULL, equaled
pointer.
This patch fixes handling the case of the NULL output stream.
GH #18019
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/IO/IO.xs | 4 ++--
dist/IO/t/io_xs.t | 10 +++++++++-
2 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index 9158106416..fb009774c4 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -397,9 +397,9 @@ ferror(handle)
CODE:
if (in)
#ifdef PerlIO
- RETVAL = PerlIO_error(in) || (in != out && PerlIO_error(out));
+ RETVAL = PerlIO_error(in) || (out && in != out && PerlIO_error(out));
#else
- RETVAL = ferror(in) || (in != out && ferror(out));
+ RETVAL = ferror(in) || (out && in != out && ferror(out));
#endif
else {
RETVAL = -1;
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
index a8833b0651..4657088629 100644
--- a/dist/IO/t/io_xs.t
+++ b/dist/IO/t/io_xs.t
@@ -11,7 +11,7 @@ BEGIN {
}
}
-use Test::More tests => 8;
+use Test::More tests => 10;
use IO::File;
use IO::Seekable;
@@ -69,3 +69,11 @@ SKIP: {
ok(!$fh->error, "check clearerr removed the error");
close $fh; # silently ignore the error
}
+
+{
+ # [GH #18019] IO::Handle->error misreported an error after successully
+ # opening a regular file for reading. It was a regression in GH #6799 fix.
+ ok(open(my $fh, '<', __FILE__), "a regular file opened for reading");
+ ok(!$fh->error, "no spurious error reported by error()");
+ close $fh;
+}
--
2.25.4

80
perl-5.33.0-IO-Handle-clear-the-error-on-both-input-and-output-s.patch
View File

@ -1,80 +0,0 @@
From fc5f3468dcbee38eb202cfd552a5b8dbff990c7b Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 12 May 2020 10:59:08 +1000
Subject: [PATCH 2/2] IO::Handle: clear the error on both input and output
streams
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Similarly to GH #6799 clearerr() only cleared the error status
of the input stream, so clear both.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/IO/IO.xs | 14 +++++++++++---
dist/IO/t/io_xs.t | 8 +++++---
2 files changed, 16 insertions(+), 6 deletions(-)
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index 99d523d2c1..9158106416 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -410,13 +410,21 @@ ferror(handle)
int
clearerr(handle)
- InputStream handle
+ SV * handle
+ PREINIT:
+ IO *io = sv_2io(handle);
+ InputStream in = IoIFP(io);
+ OutputStream out = IoOFP(io);
CODE:
if (handle) {
#ifdef PerlIO
- PerlIO_clearerr(handle);
+ PerlIO_clearerr(in);
+ if (in != out)
+ PerlIO_clearerr(out);
#else
- clearerr(handle);
+ clearerr(in);
+ if (in != out)
+ clearerr(out);
#endif
RETVAL = 0;
}
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
index f890e92558..a8833b0651 100644
--- a/dist/IO/t/io_xs.t
+++ b/dist/IO/t/io_xs.t
@@ -11,7 +11,7 @@ BEGIN {
}
}
-use Test::More tests => 7;
+use Test::More tests => 8;
use IO::File;
use IO::Seekable;
@@ -58,12 +58,14 @@ SKIP: {
# This isn't really a Linux/BSD specific test, but /dev/full is (I
# hope) reasonably well defined on these. Patches welcome if your platform
# also supports it (or something like it)
- skip "no /dev/full or not a /dev/full platform", 2
+ skip "no /dev/full or not a /dev/full platform", 3
unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full";
open my $fh, ">", "/dev/full"
- or skip "Could not open /dev/full: $!", 2;
+ or skip "Could not open /dev/full: $!", 3;
$fh->print("a" x 1024);
ok(!$fh->flush, "should fail to flush");
ok($fh->error, "stream should be in error");
+ $fh->clearerr;
+ ok(!$fh->error, "check clearerr removed the error");
close $fh; # silently ignore the error
}
--
2.25.4

61
perl-5.33.0-IO-Socket-UNIX-synchronize-behavior-with-module-docu.patch
View File

@ -1,61 +0,0 @@
From c6439962c995d4d7052af9fb3f92da93c1584b84 Mon Sep 17 00:00:00 2001
From: vividsnow <vividsnow@gmail.com>
Date: Fri, 31 Jul 2020 00:37:58 +0300
Subject: [PATCH] IO::Socket::UNIX: synchronize behavior with module
documentation (#17787)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
* synchronize behavior with module documentation
IO::Socket docs states that passing Blocking => 0 will be set socket to non-blocking mode
* Update AUTHORS
* bump version
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
AUTHORS | 1 +
dist/IO/lib/IO/Socket/UNIX.pm | 6 +++++-
2 files changed, 6 insertions(+), 1 deletion(-)
diff --git a/AUTHORS b/AUTHORS
index 577ba7d0ee..299fdec8a8 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -1293,6 +1293,7 @@ Ville Skyttä <scop@cs132170.pp.htv.fi>
Vincent Pit <perl@profvince.com>
Vishal Bhatia <vishal@deja.com>
Vitali Peil <vitali.peil@uni-bielefeld.de>
+vividsnow <vividsnow@gmail.com>
Vlad Harchev <hvv@hippo.ru>
Vladimir Alexiev <vladimir@cs.ualberta.ca>
Vladimir Marek <vlmarek@volny.cz>
diff --git a/dist/IO/lib/IO/Socket/UNIX.pm b/dist/IO/lib/IO/Socket/UNIX.pm
index 04b36eaf74..14d0b27a8c 100644
--- a/dist/IO/lib/IO/Socket/UNIX.pm
+++ b/dist/IO/lib/IO/Socket/UNIX.pm
@@ -11,7 +11,7 @@ use IO::Socket;
use Carp;
our @ISA = qw(IO::Socket);
-our $VERSION = "1.41";
+our $VERSION = "1.42";
IO::Socket::UNIX->register_domain( AF_UNIX );
@@ -30,6 +30,10 @@ sub configure {
$sock->socket(AF_UNIX, $type, 0) or
return undef;
+ if(exists $arg->{Blocking}) {
+ $sock->blocking($arg->{Blocking}) or
+ return undef;
+ }
if(exists $arg->{Local}) {
my $addr = sockaddr_un($arg->{Local});
$sock->bind($addr) or
--
2.25.4

32
perl-5.33.0-MUTABLE_PTR-Rmv-non-standard-syntax.patch
View File

@ -1,32 +0,0 @@
From 6c2255e0e80e0dc00c7fd96e073f1f524bbaa3e0 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 29 Jun 2020 09:21:24 -0600
Subject: [PATCH] MUTABLE_PTR() Rmv non-standard syntax
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Variables in C are beginning with an underscore are reserved for use by
the C implementation. Change this non-conformant usage.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
handy.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/handy.h b/handy.h
index 287e2e206d..890b2b11a2 100644
--- a/handy.h
+++ b/handy.h
@@ -54,7 +54,7 @@ Null SV pointer. (No longer available when C<PERL_CORE> is defined.)
*/
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
+# define MUTABLE_PTR(p) ({ void *p_ = (p); p_; })
#else
# define MUTABLE_PTR(p) ((void *) (p))
#endif
--
2.25.4

33
perl-5.33.0-Update-pod-for-SvTRUE-to-indicate-single-param-evalu.patch
View File

@ -1,33 +0,0 @@
From b26a606d84ae1a6da560c7cd71d1a33c0dc7178e Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sun, 14 Jun 2020 12:26:02 -0600
Subject: [PATCH] Update pod for SvTRUE, to indicate single param evaluation
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
5.32 changed this macro into an inline function so that 'sv' only gets
evaluated once, but didn't update the documentation to reflect that.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.h | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/sv.h b/sv.h
index 3721b2fb1b..ad8accbf1a 100644
--- a/sv.h
+++ b/sv.h
@@ -1607,7 +1607,8 @@ false. See C<L</SvOK>> for a defined/undefined test. Handles 'get' magic
unless the scalar is already C<SvPOK>, C<SvIOK> or C<SvNOK> (the public, not the
private flags).
-See C<L</SvTRUEx>> for a version which guarantees to evaluate C<sv> only once.
+As of Perl 5.32, this is guaranteed to evaluate C<sv> only once. Prior to that
+release, use C<L</SvTRUEx>> for single evaluation.
=for apidoc Am|bool|SvTRUE_nomg|SV* sv
Returns a boolean indicating whether Perl would evaluate the SV as true or
--
2.25.4

45
perl-5.33.0-XSUB.h-fix-MARK-and-items-variables-inside-BOOT-XSUB.patch
View File

@ -1,45 +0,0 @@
From 313464947382fab07299af0061f419a55540356a Mon Sep 17 00:00:00 2001
From: Tomasz Konojacki <me@xenu.pl>
Date: Mon, 27 Apr 2020 08:31:47 +0200
Subject: [PATCH] XSUB.h: fix MARK and items variables inside BOOT XSUBs
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
ax was incremented by Perl_xs_handshake() and because of that
MARK and items were off by one inside BOOT XSUBs.
fixes #17755
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
XSUB.h | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/XSUB.h b/XSUB.h
index e3147ce9fb..5f17a5acde 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -160,16 +160,16 @@ is a lexical C<$_> in scope.
PL_xsubfilename. */
#define dXSBOOTARGSXSAPIVERCHK \
I32 ax = XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \
- SV **mark = PL_stack_base + ax; dSP; dITEMS
+ SV **mark = PL_stack_base + ax - 1; dSP; dITEMS
#define dXSBOOTARGSAPIVERCHK \
I32 ax = XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \
- SV **mark = PL_stack_base + ax; dSP; dITEMS
+ SV **mark = PL_stack_base + ax - 1; dSP; dITEMS
/* dXSBOOTARGSNOVERCHK has no API in xsubpp to choose it so do
#undef dXSBOOTARGSXSAPIVERCHK
#define dXSBOOTARGSXSAPIVERCHK dXSBOOTARGSNOVERCHK */
#define dXSBOOTARGSNOVERCHK \
I32 ax = XS_SETXSUBFN_POPMARK; \
- SV **mark = PL_stack_base + ax; dSP; dITEMS
+ SV **mark = PL_stack_base + ax - 1; dSP; dITEMS
#define dXSTARG SV * const targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
? PAD_SV(PL_op->op_targ) : sv_newmortal())
--
2.25.4

38
perl-5.33.0-ext-XS-APItest-t-utf8_warn_base.pl-Fix-a-couple-test.patch
View File

@ -1,38 +0,0 @@
From 73b535d23d98bd3bdc31a27da26222e2e56166ac Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 30 Jun 2020 13:58:50 -0600
Subject: [PATCH] ext/XS-APItest/t/utf8_warn_base.pl: Fix a couple tests
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
These had invalid values, which didn't show up execpt on EBCDIC
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/XS-APItest/t/utf8_warn_base.pl | 2 --
1 file changed, 2 deletions(-)
diff --git a/ext/XS-APItest/t/utf8_warn_base.pl b/ext/XS-APItest/t/utf8_warn_base.pl
index d86871cd0f..a0f732282e 100644
--- a/ext/XS-APItest/t/utf8_warn_base.pl
+++ b/ext/XS-APItest/t/utf8_warn_base.pl
@@ -486,7 +486,6 @@ my @tests;
: I8_to_native(
"\xff\xa7\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf"),
0x7FFFFFFFFFFFFFFF,
- (isASCII) ? 1 : 2,
],
[ "first 64 bit code point",
(isASCII)
@@ -525,7 +524,6 @@ my @tests;
I8_to_native(
"\xff\xa0\xa0\xa0\xa0\xa0\xa1\xa0\xa0\xa0\xa0\xa0\xa0\xa0"),
0x800000000,
- 40000000
],
[ "requires at least 32 bits",
I8_to_native(
--
2.25.4

193
perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch
View File

@ -1,193 +0,0 @@
From b334474a337421c6643b872388245fb2c11bf995 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 30 Mar 2020 16:32:46 +1100
Subject: [PATCH] fix C<i $obj> where $obj is a lexical
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
the DB::eval function depends on the special behaviour of eval ""
within the DB package, which evaluates the string within the context
of the first non-DB sub or eval scope, working up the call stack.
The debugger refactor moved handling for the 'i' command from the
DB package to the DB::Obj package, so the eval in DB::eval was
working in the context of the DB::Obj::cmd_i function, not in the
calling scope.
Fixed by moving the handling for the i command back to DB.
Fixes #17661.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
lib/perl5db.pl | 65 +++++++++++++++++++++---------------------
lib/perl5db.t | 20 +++++++++++++
lib/perl5db/t/gh-17661 | 14 +++++++++
4 files changed, 68 insertions(+), 32 deletions(-)
create mode 100644 lib/perl5db/t/gh-17661
diff --git a/MANIFEST b/MANIFEST
index 8c71995174..96af3618bd 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4808,6 +4808,7 @@ lib/perl5db/t/eval-line-bug Tests for the Perl debugger
lib/perl5db/t/fact Tests for the Perl debugger
lib/perl5db/t/filename-line-breakpoint Tests for the Perl debugger
lib/perl5db/t/gh-17660 Tests for the Perl debugger
+lib/perl5db/t/gh-17661 Tests for the Perl debugger
lib/perl5db/t/load-modules Tests for the Perl debugger
lib/perl5db/t/lsub-n Test script used by perl5db.t
lib/perl5db/t/lvalue-bug Tests for the Perl debugger
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 96e56d559f..b647d24fb8 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2512,6 +2512,37 @@ EOP
return;
}
+=head3 C<_DB__handle_i_command> - inheritance display
+
+Display the (nested) parentage of the module or object given.
+
+=cut
+
+sub _DB__handle_i_command {
+ my $self = shift;
+
+ my $line = $self->cmd_args;
+ require mro;
+ foreach my $isa ( split( /\s+/, $line ) ) {
+ $evalarg = "$isa";
+ # The &-call is here to ascertain the mutability of @_.
+ ($isa) = &DB::eval;
+ no strict 'refs';
+ print join(
+ ', ',
+ map {
+ "$_"
+ . (
+ defined( ${"$_\::VERSION"} )
+ ? ' ' . ${"$_\::VERSION"}
+ : undef )
+ } @{mro::get_linear_isa(ref($isa) || $isa)}
+ );
+ print "\n";
+ }
+ next CMD;
+}
+
# 't' is type.
# 'm' is method.
# 'v' is the value (i.e: method name or subroutine ref).
@@ -2531,6 +2562,7 @@ BEGIN
'W' => { t => 'm', v => '_handle_W_command', },
'c' => { t => 's', v => \&_DB__handle_c_command, },
'f' => { t => 's', v => \&_DB__handle_f_command, },
+ 'i' => { t => 's', v => \&_DB__handle_i_command, },
'm' => { t => 's', v => \&_DB__handle_m_command, },
'n' => { t => 'm', v => '_handle_n_command', },
'p' => { t => 'm', v => '_handle_p_command', },
@@ -2551,7 +2583,7 @@ BEGIN
{ t => 's', v => \&_DB__handle_restart_and_rerun_commands, },
} qw(R rerun)),
(map { $_ => {t => 'm', v => '_handle_cmd_wrapper_commands' }, }
- qw(a A b B e E h i l L M o O v w W)),
+ qw(a A b B e E h l L M o O v w W)),
);
};
@@ -5468,37 +5500,6 @@ sub cmd_h {
}
} ## end sub cmd_h
-=head3 C<cmd_i> - inheritance display
-
-Display the (nested) parentage of the module or object given.
-
-=cut
-
-sub cmd_i {
- my $cmd = shift;
- my $line = shift;
-
- require mro;
-
- foreach my $isa ( split( /\s+/, $line ) ) {
- $evalarg = $isa;
- # The &-call is here to ascertain the mutability of @_.
- ($isa) = &DB::eval;
- no strict 'refs';
- print join(
- ', ',
- map {
- "$_"
- . (
- defined( ${"$_\::VERSION"} )
- ? ' ' . ${"$_\::VERSION"}
- : undef )
- } @{mro::get_linear_isa(ref($isa) || $isa)}
- );
- print "\n";
- }
-} ## end sub cmd_i
-
=head3 C<cmd_l> - list lines (command)
Most of the command is taken up with transforming all the different line
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 913a301d98..ffa659a215 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -2946,6 +2946,26 @@ SKIP:
);
}
+{
+ # gh #17661
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'c',
+ 'i $obj',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/gh-17661',
+ }
+ );
+
+ $wrapper->output_like(
+ qr/C5, C1, C2, C3, C4/,
+ q/check for reasonable result/,
+ );
+}
+
SKIP:
{
$Config{usethreads}
diff --git a/lib/perl5db/t/gh-17661 b/lib/perl5db/t/gh-17661
new file mode 100644
index 0000000000..0d85977b35
--- /dev/null
+++ b/lib/perl5db/t/gh-17661
@@ -0,0 +1,14 @@
+use v5.10.0;
+
+{ package C1; sub c1 { } our @ISA = qw(C2) }
+{ package C2; sub c2 { } our @ISA = qw(C3) }
+{ package C3; sub c3 { } our @ISA = qw( ) }
+{ package C4; sub c4 { } our @ISA = qw( ) }
+{ package C5; sub c5 { } our @ISA = qw(C1 C4) }
+
+my $obj = bless {}, 'C5';
+$main::global = bless {}, 'C5';
+
+$DB::single = 1;
+
+say "Done.";
--
2.25.4

71
perl-5.33.0-list-assign-in-list-context-honour-LHS-undef.patch
View File

@ -1,71 +0,0 @@
From 282d9dfeb4cea3c2d0335ba78faa3a9db931f1ec Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 11 Aug 2020 13:58:51 +0100
Subject: [PATCH] list assign in list context: honour LHS undef
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
GH #16685
In
@a = ($x, undef, undef) = (1))
@a should have 3 elements. v5.25.6-79-gb09ed995ad broke this and was
returning one element.
The fix is simple: that previous commit made it so that elements were
pushed back onto the stack only if they weren't immortal, so
&PL_sv_undef was getting skipped. Make it so they always are.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_hot.c | 2 +-
t/op/aassign.t | 10 +++++++++-
2 files changed, 10 insertions(+), 2 deletions(-)
diff --git a/pp_hot.c b/pp_hot.c
index e9f1ffe7a4..3564dd7e12 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2743,8 +2743,8 @@ PP(pp_aassign)
if (!SvIMMORTAL(lsv)) {
sv_set_undef(lsv);
SvSETMAGIC(lsv);
- *relem++ = lsv;
}
+ *relem++ = lsv;
break;
} /* switch */
} /* while */
diff --git a/t/op/aassign.t b/t/op/aassign.t
index 9128f9fd98..aa1f2c722c 100644
--- a/t/op/aassign.t
+++ b/t/op/aassign.t
@@ -595,7 +595,7 @@ SKIP: {
}
{
- # GH #17816
+ # GH #16685
# don't use the "1-arg on LHS can't be common" optimisation
# when there are undef's there
my $x = 1;
@@ -603,5 +603,13 @@ SKIP: {
is("@a", "2 1", "GH #17816");
}
+{
+ # GH #17816
+ # honour trailing undef's in list context
+ my $x = 1;
+ my @a = (($x, undef, undef) = (1));
+ is(scalar @a, 3, "GH #17816");
+}
+
done_testing();
--
2.25.4

76
perl-5.33.0-list-assign-in-list-context-was-over-optimising.patch
View File

@ -1,76 +0,0 @@
From 5b354d2a8a6fea46c62048464c6722560cb1c907 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 11 Aug 2020 11:55:46 +0100
Subject: [PATCH] list assign in list context was over-optimising
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
GH #17816
This code:
my $x = 1;
print (($x, undef) = (2 => $x));
was printing "22" when it should have been printing "21".
An optimisation skips the 'common values on both sides' test
when the LHS of an assign only contains a single var; as the example
above shows, this is not sufficient.
This was broken by v5.23.1-202-g808ce55782
This commit fixes it by counting undef's on the LHS towards the var
count if they don't appear first.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
op.c | 10 +++++++---
t/op/aassign.t | 10 ++++++++++
2 files changed, 17 insertions(+), 3 deletions(-)
diff --git a/op.c b/op.c
index 05f6d9d1a3..49aac853d4 100644
--- a/op.c
+++ b/op.c
@@ -15679,11 +15679,15 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, int *scalars_p)
goto do_next;
case OP_UNDEF:
- /* undef counts as a scalar on the RHS:
- * (undef, $x) = ...; # only 1 scalar on LHS: always safe
+ /* undef on LHS following a var is significant, e.g.
+ * my $x = 1;
+ * @a = (($x, undef) = (2 => $x));
+ * # @a shoul be (2,1) not (2,2)
+ *
+ * undef on RHS counts as a scalar:
* ($x, $y) = (undef, $x); # 2 scalars on RHS: unsafe
*/
- if (rhs)
+ if ((!rhs && *scalars_p) || rhs)
(*scalars_p)++;
flags = AAS_SAFE_SCALAR;
break;
diff --git a/t/op/aassign.t b/t/op/aassign.t
index ed904adc62..9128f9fd98 100644
--- a/t/op/aassign.t
+++ b/t/op/aassign.t
@@ -594,4 +594,14 @@ SKIP: {
is ($fill, 2, "RT #130132 array 2");
}
+{
+ # GH #17816
+ # don't use the "1-arg on LHS can't be common" optimisation
+ # when there are undef's there
+ my $x = 1;
+ my @a = (($x, undef) = (2 => $x));
+ is("@a", "2 1", "GH #17816");
+}
+
+
done_testing();
--
2.25.4

87
perl-5.33.0-make-fh-error-report-errors-from-both-input-and-outp.patch
View File

@ -1,87 +0,0 @@
From 89341f87f9fc65c4d7133e497bb04586e86b8052 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 12 May 2020 10:29:17 +1000
Subject: [PATCH 1/2] make $fh->error report errors from both input and output
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
For character devices and sockets perl uses separate PerlIO objects
for input and output so they can be buffered separately.
The IO::Handle::error() method only checked the input stream, so
if a write error occurs error() would still returned false.
Change this so both the input and output streams are checked.
fixes #6799
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/IO/IO.xs | 12 ++++++++----
dist/IO/t/io_xs.t | 19 ++++++++++++++++++-
2 files changed, 26 insertions(+), 5 deletions(-)
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index 68b7352c38..99d523d2c1 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -389,13 +389,17 @@ ungetc(handle, c)
int
ferror(handle)
- InputStream handle
+ SV * handle
+ PREINIT:
+ IO *io = sv_2io(handle);
+ InputStream in = IoIFP(io);
+ OutputStream out = IoOFP(io);
CODE:
- if (handle)
+ if (in)
#ifdef PerlIO
- RETVAL = PerlIO_error(handle);
+ RETVAL = PerlIO_error(in) || (in != out && PerlIO_error(out));
#else
- RETVAL = ferror(handle);
+ RETVAL = ferror(in) || (in != out && ferror(out));
#endif
else {
RETVAL = -1;
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
index 1e3c49a4a7..f890e92558 100644
--- a/dist/IO/t/io_xs.t
+++ b/dist/IO/t/io_xs.t
@@ -11,7 +11,7 @@ BEGIN {
}
}
-use Test::More tests => 5;
+use Test::More tests => 7;
use IO::File;
use IO::Seekable;
@@ -50,3 +50,20 @@ SKIP:
ok($fh->sync, "sync to a read only handle")
or diag "sync(): ", $!;
}
+
+
+SKIP: {
+ # gh 6799
+ #
+ # This isn't really a Linux/BSD specific test, but /dev/full is (I
+ # hope) reasonably well defined on these. Patches welcome if your platform
+ # also supports it (or something like it)
+ skip "no /dev/full or not a /dev/full platform", 2
+ unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full";
+ open my $fh, ">", "/dev/full"
+ or skip "Could not open /dev/full: $!", 2;
+ $fh->print("a" x 1024);
+ ok(!$fh->flush, "should fail to flush");
+ ok($fh->error, "stream should be in error");
+ close $fh; # silently ignore the error
+}
--
2.25.4

72
perl-5.33.0-perl-17844-don-t-update-SvCUR-until-after-we-ve-done.patch
View File

@ -1,72 +0,0 @@
From 45f235c116d4deab95c576aff77fe46d609f8553 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 15 Apr 2019 15:23:32 +1000
Subject: [PATCH] (perl #17844) don't update SvCUR until after we've done
moving
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
SvCUR() before the SvGROW() calls could result in reading beyond the
end of a buffer.
It wasn't a problem in the normal case, since sv_grow() just calls
realloc() which has its own notion of how big the memory block is, but
if the SV is SvOOK() sv_backoff() tries to move SvCUR()+1 bytes, which
might be larger than the currently allocated size of the PV.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
doop.c | 2 +-
t/op/bop.t | 11 ++++++++++-
2 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/doop.c b/doop.c
index 88220092c3..c9c953212e 100644
--- a/doop.c
+++ b/doop.c
@@ -1087,7 +1087,6 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
lsave = lc;
rsave = rc;
- SvCUR_set(sv, len);
(void)SvPOK_only(sv);
if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
dc = SvPV_force_nomg_nolen(sv);
@@ -1103,6 +1102,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL);
dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
}
+ SvCUR_set(sv, len);
if (len >= sizeof(long)*4 &&
!(PTR2nat(dc) % sizeof(long)) &&
diff --git a/t/op/bop.t b/t/op/bop.t
index eecd90387f..07f057d0a9 100644
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -18,7 +18,7 @@ BEGIN {
# If you find tests are failing, please try adding names to tests to track
# down where the failure is, and supply your new names as a patch.
# (Just-in-time test naming)
-plan tests => 501;
+plan tests => 502;
# numerics
ok ((0xdead & 0xbeef) == 0x9ead);
@@ -669,3 +669,12 @@ foreach my $op_info ([and => "&"], [or => "|"], [xor => "^"]) {
like $@, $expected, $description;
}
}
+
+{
+ # perl #17844 - only visible with valgrind/ASAN
+ fresh_perl_is(<<'EOS',
+formline X000n^\\0,\\0^\\0for\0,0..10
+EOS
+ '',
+ {}, "[perl #17844] access beyond end of block");
+}
--
2.25.4

58
perl-5.33.0-reentr.c-Buffer-sizes-for-asctime_r-ctime_r-are-smal.patch
View File

@ -1,58 +0,0 @@
From 81169c06a76f62ff987ed990ac910c2ae08b3f91 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 10 Mar 2020 15:19:57 -0600
Subject: [PATCH] reentr.c: Buffer sizes for asctime_r,ctime_r are small
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The needed sizes of these are stated in the man pages, and are much
smaller than were being allocated.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
reentr.c | 4 ++--
regen/reentr.pl | 5 ++++-
2 files changed, 6 insertions(+), 3 deletions(-)
diff --git a/reentr.c b/reentr.c
index 8ddda7bfc0..8438c8f90f 100644
--- a/reentr.c
+++ b/reentr.c
@@ -52,14 +52,14 @@ Perl_reentrant_size(pTHX) {
# define REENTRANTUSUALSIZE 4096 /* Make something up. */
# ifdef HAS_ASCTIME_R
- PL_reentrant_buffer->_asctime_size = REENTRANTSMALLSIZE;
+ PL_reentrant_buffer->_asctime_size = 26;
# endif /* HAS_ASCTIME_R */
# ifdef HAS_CRYPT_R
# endif /* HAS_CRYPT_R */
# ifdef HAS_CTIME_R
- PL_reentrant_buffer->_ctime_size = REENTRANTSMALLSIZE;
+ PL_reentrant_buffer->_ctime_size = 26;
# endif /* HAS_CTIME_R */
# ifdef HAS_GETGRNAM_R
diff --git a/regen/reentr.pl b/regen/reentr.pl
index f5788c7ad9..94721e9dec 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -495,8 +495,11 @@ for my $func (@seenf) {
char* _${func}_buffer;
size_t _${func}_size;
EOF
+ my $size = ($func =~ /^(asctime|ctime)$/)
+ ? 26
+ : "REENTRANTSMALLSIZE";
push @size, <<EOF;
- PL_reentrant_buffer->_${func}_size = REENTRANTSMALLSIZE;
+ PL_reentrant_buffer->_${func}_size = $size;
EOF
pushinitfree $func;
pushssif $endif;
--
2.25.4

46
perl-5.33.0-reentr.c-Prevent-infinite-looping.patch
View File

@ -1,46 +0,0 @@
From 981fbfc16220a15e72457d8ece4e014988746946 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Thu, 12 Mar 2020 12:48:47 -0600
Subject: [PATCH] reentr.c: Prevent infinite looping
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This is an easy, though paranoid hedge to prevent something that should
never happen from causing an infinite loop if it were to happen.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
reentr.c | 2 +-
regen/reentr.pl | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/reentr.c b/reentr.c
index 8438c8f90f..2429aa2f5d 100644
--- a/reentr.c
+++ b/reentr.c
@@ -36,7 +36,7 @@
#define RenewDouble(data_pointer, size_pointer, type) \
STMT_START { \
- const size_t size = *(size_pointer) * 2; \
+ const size_t size = MAX(*(size_pointer), 1) * 2; \
Renew((data_pointer), (size), type); \
*(size_pointer) = size; \
} STMT_END
diff --git a/regen/reentr.pl b/regen/reentr.pl
index 94721e9dec..ba2e1c8fa6 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -818,7 +818,7 @@ print $c <<"EOF";
#define RenewDouble(data_pointer, size_pointer, type) \\
STMT_START { \\
- const size_t size = *(size_pointer) * 2; \\
+ const size_t size = MAX(*(size_pointer), 1) * 2; \\
Renew((data_pointer), (size), type); \\
*(size_pointer) = size; \\
} STMT_END
--
2.25.4

31
perl-5.33.0-sv.h-Wanted-UOK-but-said-IOK.patch
View File

@ -1,31 +0,0 @@
From 530e9296a21b673d7e4c2b42f18d0d52d00f35c4 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sun, 28 Jun 2020 12:03:54 -0600
Subject: [PATCH] sv.h: Wanted UOK, but said IOK
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
I don't know the consequences of this bug
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/sv.h b/sv.h
index 2f6431a826..3721b2fb1b 100644
--- a/sv.h
+++ b/sv.h
@@ -1711,7 +1711,7 @@ Like C<sv_catsv> but doesn't process magic.
#define SvNV(sv) (SvNOK_nog(sv) ? SvNVX(sv) : sv_2nv(sv))
#define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
-#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
+#define SvUV_nomg(sv) (SvUOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
#define SvNV_nomg(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv_flags(sv, 0))
/* ----*/
--
2.25.4

88
perl-5.33.1-Heap-buffer-overflow-in-regex-bracket-group-whitespa.patch
View File

@ -1,88 +0,0 @@
From 90f66c42e4513ae5d907805fbf28b9967a90d6c5 Mon Sep 17 00:00:00 2001
From: John Lightsey <john@04755.net>
Date: Fri, 28 Aug 2020 23:39:18 -0500
Subject: [PATCH] Heap buffer overflow in regex bracket group whitespace
handling
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The code for skipping whitespace in regex bracket character groups
was walking past the end of the regex in some cases.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/regcomp.c b/regcomp.c
index db82c77b00..64488994fa 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -17228,10 +17228,10 @@ S_add_multi_match(pTHX_ AV* multi_char_matches, SV* multi_string, const STRLEN c
*
* There is a line below that uses the same white space criteria but is outside
* this macro. Both here and there must use the same definition */
-#define SKIP_BRACKETED_WHITE_SPACE(do_skip, p) \
+#define SKIP_BRACKETED_WHITE_SPACE(do_skip, p, stop_p) \
STMT_START { \
if (do_skip) { \
- while (isBLANK_A(UCHARAT(p))) \
+ while (p < stop_p && isBLANK_A(UCHARAT(p))) \
{ \
p++; \
} \
@@ -17406,7 +17406,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
initial_listsv_len = SvCUR(listsv);
SvTEMP_off(listsv); /* Grr, TEMPs and mortals are conflated. */
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
assert(RExC_parse <= RExC_end);
@@ -17415,7 +17415,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
invert = TRUE;
allow_mutiple_chars = FALSE;
MARK_NAUGHTY(1);
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
}
/* Check that they didn't say [:posix:] instead of [[:posix:]] */
@@ -17462,12 +17462,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
output_posix_warnings(pRExC_state, posix_warnings);
}
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
+
if (RExC_parse >= stop_ptr) {
break;
}
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
-
if (UCHARAT(RExC_parse) == ']') {
break;
}
@@ -18156,7 +18156,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
}
} /* end of namedclass \blah */
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
/* If 'range' is set, 'value' is the ending of a range--check its
* validity. (If value isn't a single code point in the case of a
@@ -18199,7 +18199,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
char* next_char_ptr = RExC_parse + 1;
/* Get the next real char after the '-' */
- SKIP_BRACKETED_WHITE_SPACE(skip_white, next_char_ptr);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, next_char_ptr, RExC_end);
/* If the '-' is at the end of the class (just before the ']',
* it is a literal minus; otherwise it is a range */
--
2.25.4

55
perl-5.33.1-die_unwind-global-destruction.patch
View File

@ -1,55 +0,0 @@
From 042abef72d40ab7ff39127e2afae6e34dfc66404 Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Fri, 14 Aug 2020 16:16:22 -0500
Subject: [PATCH] die_unwind(): global destruction
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Fix #18063
During global destruction make sure we preserve
the string by using mortalcopy.
This is an update on 8c86f0238ecb5f32c2e7fba36e3edfdb54069068
change which avoided sv_mortalcopy in favor of sv_2mortal.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_ctl.c | 6 +++++-
t/op/die_unwind.t | 4 ++++
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/pp_ctl.c b/pp_ctl.c
index b8cd869ee0..cc244d7ba7 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1716,7 +1716,11 @@ Perl_die_unwind(pTHX_ SV *msv)
* when unlocalising a tied var). So we do a dance with
* mortalising and SAVEFREEing.
*/
- sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
+ if (PL_phase == PERL_PHASE_DESTRUCT) {
+ exceptsv = sv_mortalcopy(exceptsv);
+ } else {
+ exceptsv = sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
+ }
/*
* Historically, perl used to set ERRSV ($@) early in the die
diff --git a/t/op/die_unwind.t b/t/op/die_unwind.t
index eee1ce534b..4b83ee6fac 100644
--- a/t/op/die_unwind.t
+++ b/t/op/die_unwind.t
@@ -69,4 +69,8 @@ is($uerr, "t3\n");
is($val, undef, "undefined return value from 'eval' block with 'die'");
is($err, "t3\n");
+fresh_perl_like(<<'EOS', qr/Custom Message During Global Destruction/, { switches => ['-w'], stderr => 1 } );
+package Foo; sub DESTROY { die "Custom Message During Global Destruction" }; package main; our $wut = bless [], "Foo"
+EOS
+
done_testing();
--
2.25.4

77
perl-5.33.1-sort-return-foo.patch
View File

@ -1,77 +0,0 @@
From 390fe0c0d09aadc66f644e9eee4aa1245221188c Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 25 Aug 2020 13:15:25 +0100
Subject: [PATCH] sort { return foo() } ...
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
GH #18081
A sub call via return in a sort block was called in void rather than
scalar context, causing the comparison result to be discarded.
This because when a sort block is called it is not a real function
call, even though a sort block can be returned from. Instead, a
CXt_NULL is pushed on the context stack. Because this isn't a sub-ish
context type (unlike CXt_SUB, CXt_EVAL etc) there is no 'caller sub'
on the context stack to be found to retrieve the caller's context
(i.e. cx->cx_gimme).
This commit fixes it by special-casing Perl_gimme_V().
Ideally at some future point, a new context type, CXt_SORT, should be
added. This would be used instead of CXt_NULL when a sort BLOCK is
called. Like other sub-ish context types, it would have an old_cxsubix
field and PL_curstackinfo->si_cxsubix would point to it. This would
eliminate needing special-case handling in places like Perl_gimme_V().
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
inline.h | 2 +-
t/op/sort.t | 12 +++++++++++-
2 files changed, 12 insertions(+), 2 deletions(-)
diff --git a/inline.h b/inline.h
index a8240efb9c..6fbd5abfea 100644
--- a/inline.h
+++ b/inline.h
@@ -2086,7 +2086,7 @@ Perl_gimme_V(pTHX)
return gimme;
cxix = PL_curstackinfo->si_cxsubix;
if (cxix < 0)
- return G_VOID;
+ return PL_curstackinfo->si_type == PERLSI_SORT ? G_SCALAR: G_VOID;
assert(cxstack[cxix].blk_gimme & G_WANT);
return (cxstack[cxix].blk_gimme & G_WANT);
}
diff --git a/t/op/sort.t b/t/op/sort.t
index f2e139dff0..8e387fb90d 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -7,7 +7,7 @@ BEGIN {
set_up_inc('../lib');
}
use warnings;
-plan(tests => 203);
+plan(tests => 204);
use Tie::Array; # we need to test sorting tied arrays
# these shouldn't hang
@@ -1202,3 +1202,13 @@ SKIP:
$fillb = undef;
is $act, "01[sortb]2[fillb]";
}
+
+# GH #18081
+# sub call via return in sort block was called in void rather than scalar
+# context
+
+{
+ sub sort18081 { $a + 1 <=> $b + 1 }
+ my @a = sort { return &sort18081 } 6,1,2;
+ is "@a", "1 2 6", "GH #18081";
+}
--
2.25.4

77
perl-5.33.2-Remove-Perl_av_top_index.patch
View File

@ -1,77 +0,0 @@
From bd5fa06648085e8c17efd55abeb6424aeeb1018e Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 29 Sep 2020 00:48:19 -0600
Subject: [PATCH] Remove Perl_av_top_index
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
I created this in 87306e0674dfe3af29804b4641347cd5ac9b0521, thinking it
was needed to preserve backward compatibility if someone were using this
instead of the macro. But it turned out that there never was such a
function, it was inlined, and the name was S_av_top_index, so there is
no reason to create a new function that no one has ever been able to
call. So just remove it, and let all accesses go through the macro
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
av.c | 10 ----------
embed.fnc | 2 +-
proto.h | 7 +++----
3 files changed, 4 insertions(+), 15 deletions(-)
diff --git a/av.c b/av.c
index ada09cde9a..ad2429f90d 100644
--- a/av.c
+++ b/av.c
@@ -1095,16 +1095,6 @@ Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
return sv;
}
-SSize_t
-Perl_av_top_index(pTHX_ AV *av)
-{
- PERL_ARGS_ASSERT_AV_TOP_INDEX;
- assert(SvTYPE(av) == SVt_PVAV);
-
- return AvFILL(av);
-}
-
-
/*
* ex: set ts=8 sts=4 sw=4 et:
*/
diff --git a/embed.fnc b/embed.fnc
index a6b4d0350f..f5c5b29c2d 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -637,7 +637,7 @@ Apd |void |av_push |NN AV *av|NN SV *val
EXp |void |av_reify |NN AV *av
ApdR |SV* |av_shift |NN AV *av
Apd |SV** |av_store |NN AV *av|SSize_t key|NULLOK SV *val
-AMdRp |SSize_t|av_top_index |NN AV *av
+AmdR |SSize_t|av_top_index |NN AV *av
AidRp |Size_t |av_count |NN AV *av
AmdR |SSize_t|av_tindex |NN AV *av
Apd |void |av_undef |NN AV *av
diff --git a/proto.h b/proto.h
index c4490fc46e..2da1a07761 100644
--- a/proto.h
+++ b/proto.h
@@ -291,10 +291,9 @@ PERL_CALLCONV SV** Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val);
__attribute__warn_unused_result__; */
#define PERL_ARGS_ASSERT_AV_TINDEX
-PERL_CALLCONV SSize_t Perl_av_top_index(pTHX_ AV *av)
- __attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT_AV_TOP_INDEX \
- assert(av)
+/* PERL_CALLCONV SSize_t av_top_index(pTHX_ AV *av)
+ __attribute__warn_unused_result__; */
+#define PERL_ARGS_ASSERT_AV_TOP_INDEX
PERL_CALLCONV void Perl_av_undef(pTHX_ AV *av);
#define PERL_ARGS_ASSERT_AV_UNDEF \
--
2.25.4

56
perl-5.33.2-gh18096-assume-worst-case-for-GOSUBs-we-don-t-analys.patch
View File

@ -1,56 +0,0 @@
From f4cd5e29bc15621f2ab8fc5d7de0e68e62d43999 Mon Sep 17 00:00:00 2001
From: Hugo van der Sanden <hv@crypt.org>
Date: Tue, 15 Sep 2020 14:02:54 +0100
Subject: [PATCH] [gh18096] assume worst-case for GOSUBs we don't analyse
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
During study_chunk, under various conditions we avoid recursing into
a GOSUB. But we must avoid giving the enclosing scope the idea that
this GOSUB would match only an empty string, since that could trigger
wrong optimizations (eg CURLYX => CURLYM in the ticket).
So we mark the construct as infinite, as in the code branch where we
_do_ recurse into it.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 7 ++++++-
t/re/re_tests | 2 ++
2 files changed, 8 insertions(+), 1 deletion(-)
diff --git a/regcomp.c b/regcomp.c
index 124ea5b90b..fae3f8079d 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -5212,7 +5212,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
* might result in a minlen of 1 and not of 4,
* but this doesn't make us mismatch, just try a bit
* harder than we should.
- * */
+ *
+ * However we must assume this GOSUB is infinite, to
+ * avoid wrongly applying other optimizations in the
+ * enclosing scope - see GH 18096, for example.
+ */
+ is_inf = is_inf_internal = 1;
scan= regnext(scan);
continue;
}
diff --git a/t/re/re_tests b/t/re/re_tests
index 554a7004a2..ab5a0d8012 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -2023,6 +2023,8 @@ AB\s+\x{100} AB \x{100}X y - -
/(?iaax:A? \K +)/ African_Feh c - \\K + is forbidden - matches null string many times in regex
/(?iaa:A?\K+)/ African_Feh c - \\K+ is forbidden - matches null string many times in regex
/(?iaa:A?\K*)/ African_Feh c - \\K* is forbidden - matches null string many times in regex
+^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + b + <c + d> y $1 a + b # [GH #18096]
+^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + <b> + c y $1 a + <b> # [GH #18096]
# Keep these lines at the end of the file
# pat string y/n/etc expr expected-expr skip-reason comment
# vim: softtabstop=0 noexpandtab
--
2.25.4

31
perl-5.33.2-mro.xs-Fix-compiler-warning.patch
View File

@ -1,31 +0,0 @@
From fa353c3d2833fc326233e0eb583753b4d7887a63 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sun, 4 Oct 2020 11:07:19 -0600
Subject: [PATCH] mro.xs: Fix compiler warning
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Fixes GH #18155
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/mro/mro.xs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs
index f21216af6e..8ce5844904 100644
--- a/ext/mro/mro.xs
+++ b/ext/mro/mro.xs
@@ -253,7 +253,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
hierarchy is not C3-incompatible */
if(!winner) {
SV *errmsg;
- I32 i;
+ Size_t i;
errmsg = newSVpvf(
"Inconsistent hierarchy during C3 merge of class '%" HEKf "':\n\t"
--
2.25.4

32
perl-5.33.2-sv.c-Added-missing-braces-in-Perl_sv_inc_nomg.patch
View File

@ -1,32 +0,0 @@
From 5777cf812c2812ea45eeb45e48979bab544d71af Mon Sep 17 00:00:00 2001
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
Date: Thu, 8 Oct 2020 19:02:10 +0900
Subject: [PATCH] sv.c: Added missing braces in Perl_sv_inc_nomg().
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.c | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/sv.c b/sv.c
index 82248e3b1f..57fd65a5b8 100644
--- a/sv.c
+++ b/sv.c
@@ -8944,9 +8944,10 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
if (SvIsUV(sv)) {
if (SvUVX(sv) == UV_MAX)
sv_setnv(sv, UV_MAX_P1);
- else
+ else {
(void)SvIOK_only_UV(sv);
SvUV_set(sv, SvUVX(sv) + 1);
+ }
} else {
if (SvIVX(sv) == IV_MAX)
sv_setuv(sv, (UV)IV_MAX + 1);
--
2.25.4

36
perl-5.33.2-sv.h-sv_collxfrm-didn-t-work-properly.patch
View File

@ -1,36 +0,0 @@
From e17dadf36f7b4348e59076240c880d0c78b33fa9 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 22 Sep 2020 08:47:52 -0600
Subject: [PATCH] sv.h: sv_collxfrm didn't work properly
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
It is supposed to be a wrapper for sv_collxfrm_flags, but it was just
calling sv_cmp_flags instead. The consequences are none except under
'use locale' in which case you always got the C locale. I did not add
tests, because it is really a pain to write portable locale tests, and
this doesn't seem to be much used. In core the '_flags' form was always
used.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/sv.h b/sv.h
index 19ce718ac3..44414b35a9 100644
--- a/sv.h
+++ b/sv.h
@@ -2045,7 +2045,7 @@ Like C<sv_catsv> but doesn't process magic.
#define sv_eq(sv1, sv2) sv_eq_flags(sv1, sv2, SV_GMAGIC)
#define sv_cmp(sv1, sv2) sv_cmp_flags(sv1, sv2, SV_GMAGIC)
#define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC)
-#define sv_collxfrm(sv, nxp) sv_cmp_flags(sv, nxp, SV_GMAGIC)
+#define sv_collxfrm(sv, nxp) sv_collxfrm_flags(sv, nxp, SV_GMAGIC)
#define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC)
#define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0)
#define sv_insert(bigstr, offset, len, little, littlelen) \
--
2.25.4

76
perl-5.33.3-Perl_custom_op_get_field-remove-undef-behaviour.patch
View File

@ -1,76 +0,0 @@
From e050064b67c501e9fdc7bc3f513ba2b8b9e795f8 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Fri, 30 Oct 2020 20:50:58 +0000
Subject: [PATCH] Perl_custom_op_get_field(): remove undef behaviour
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Thus function has a couple a switches with
default:
NOT_REACHED; /* NOTREACHED */
but clang is complaining that the value returned by the function is
undefined if those default branches are taken, since the 'any' variable
doesn't get set in that path.
Replace the NOTREACHED with a croak("panic: ..."). It's possible (albeit
not intended) for Perl_custom_op_get_field() to be called with a 'field'
arg which triggers the default case. So if this ever happens, make it
clear that something has gone wrong, rather than just silently
continuing on non-debugging builds.
In any case, this shuts up clang.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
op.c | 14 ++++++--------
1 file changed, 6 insertions(+), 8 deletions(-)
diff --git a/op.c b/op.c
index c30c6b7c8f..2933e2ed7d 100644
--- a/op.c
+++ b/op.c
@@ -18100,6 +18100,7 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
else
xop = INT2PTR(XOP *, SvIV(HeVAL(he)));
}
+
{
XOPRETANY any;
if(field == XOPe_xop_ptr) {
@@ -18121,7 +18122,10 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
any.xop_peep = xop->xop_peep;
break;
default:
- NOT_REACHED; /* NOTREACHED */
+ field_panic:
+ Perl_croak(aTHX_
+ "panic: custom_op_get_field(): invalid field %d\n",
+ (int)field);
break;
}
} else {
@@ -18139,17 +18143,11 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
any.xop_peep = XOPd_xop_peep;
break;
default:
- NOT_REACHED; /* NOTREACHED */
+ goto field_panic;
break;
}
}
}
- /* On some platforms (HP-UX, IA64) gcc emits a warning for this function:
- * op.c: In function 'Perl_custom_op_get_field':
- * op.c:...: warning: 'any.xop_name' may be used uninitialized in this function [-Wmaybe-uninitialized]
- * This is because on those platforms (with -DEBUGGING) NOT_REACHED
- * expands to assert(0), which expands to ((0) ? (void)0 :
- * __assert(...)), and gcc doesn't know that __assert can never return. */
return any;
}
}
--
2.25.4

57
perl-5.33.3-fetch-magic-on-the-first-stacked-filetest-not-the-la.patch
View File

@ -1,57 +0,0 @@
From f877e124a20d4f94c82c36e6b7a99b4e9663e204 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 10 Nov 2020 15:50:27 +1100
Subject: [PATCH] fetch magic on the first stacked filetest, not the last
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
fixes #18293
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_sys.c | 2 +-
t/op/filetest.t | 10 +++++++++-
2 files changed, 10 insertions(+), 2 deletions(-)
diff --git a/pp_sys.c b/pp_sys.c
index 66c5d9aade..5c9f768eaf 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3067,7 +3067,7 @@ S_try_amagic_ftest(pTHX_ char chr) {
SV *const arg = *PL_stack_sp;
assert(chr != '?');
- if (!(PL_op->op_private & OPpFT_STACKING)) SvGETMAGIC(arg);
+ if (!(PL_op->op_private & OPpFT_STACKED)) SvGETMAGIC(arg);
if (SvAMAGIC(arg))
{
diff --git a/t/op/filetest.t b/t/op/filetest.t
index fe9724c59a..7c471c050c 100644
--- a/t/op/filetest.t
+++ b/t/op/filetest.t
@@ -9,7 +9,7 @@ BEGIN {
set_up_inc(qw '../lib ../cpan/Perl-OSType/lib');
}
-plan(tests => 57 + 27*14);
+plan(tests => 58 + 27*14);
if ($^O =~ /MSWin32|cygwin|msys/ && !is_miniperl) {
require Win32; # for IsAdminUser()
@@ -385,3 +385,11 @@ SKIP: {
ok(!-f "TEST\0-", '-f on name with \0');
ok(!-r "TEST\0-", '-r on name with \0');
}
+
+{
+ # github #18293
+ "" =~ /(.*)/;
+ my $x = $1; # call magic on $1, setting the pv to ""
+ "test.pl" =~ /(.*)/;
+ ok(-f -r $1, "stacked handles on a name with magic");
+}
--
2.25.4

54
perl-5.33.3-pp_split-add-TonyC-s-stack-not-refcounted-suggestion.patch
View File

@ -1,54 +0,0 @@
From ab307de390c3459badcc89b3d77542b5b871b2e8 Mon Sep 17 00:00:00 2001
From: Richard Leach <richardleach@users.noreply.github.com>
Date: Tue, 20 Oct 2020 18:16:38 +0100
Subject: [PATCH 2/2] pp_split: add TonyC's stack-not-refcounted-suggestion and
tests
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp.c | 5 ++++-
t/op/split.t | 5 +++++
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/pp.c b/pp.c
index ce16c56e63..5b5e163011 100644
--- a/pp.c
+++ b/pp.c
@@ -6034,6 +6034,9 @@ PP(pp_split)
oldsave = PL_savestack_ix;
}
+ /* Some defence against stack-not-refcounted bugs */
+ (void)sv_2mortal(SvREFCNT_inc_simple_NN(ary));
+
if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
@@ -6356,7 +6359,7 @@ PP(pp_split)
}
PUTBACK;
- LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */
+ LEAVE_SCOPE(oldsave);
SPAGAIN;
if (realarray) {
if (!mg) {
diff --git a/t/op/split.t b/t/op/split.t
index 1d78a45bde..7a321645ac 100644
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -703,3 +703,8 @@ fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");',
fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");',
'',{},'(@ary = split ...) survives an (undef @ary)');
+# check the (@ary = split) optimisation survives stack-not-refcounted bugs
+fresh_perl_is('our @ary; @ary = split(/\w(?{ *ary = 0 })/, "abc");',
+ '',{},'(@ary = split ...) survives @ary destruction via typeglob');
+fresh_perl_is('my $ary = []; @$ary = split(/\w(?{ $ary = [] })/, "abc");',
+ '',{},'(@ary = split ...) survives @ary destruction via reassignment');
--
2.25.4

71
perl-5.33.3-t-op-inc.t-t-op-hexfp.t-t-op-sprintf2.t-Add-missing-.patch
View File

@ -1,71 +0,0 @@
From b52b6c4029b51818442d64c6104d26e12e140f09 Mon Sep 17 00:00:00 2001
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
Date: Thu, 5 Nov 2020 22:06:16 +0900
Subject: [PATCH] t/op/inc.t, t/op/hexfp.t, t/op/sprintf2.t: Add missing d_
prefixes for Config variable names.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/op/hexfp.t | 2 +-
t/op/inc.t | 4 ++--
t/op/sprintf2.t | 4 ++--
3 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/t/op/hexfp.t b/t/op/hexfp.t
index b0c85cfdc6..5fb80d3d74 100644
--- a/t/op/hexfp.t
+++ b/t/op/hexfp.t
@@ -246,7 +246,7 @@ SKIP: {
skip("non-80-bit-long-double", 4)
unless ($Config{uselongdouble} &&
($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
- ($Config{long_double_style_ieee_extended}));
+ ($Config{d_long_double_style_ieee_extended}));
is(0x1p-1074, 4.94065645841246544e-324);
is(0x1p-1075, 2.47032822920623272e-324, '[perl #128919]');
is(0x1p-1076, 1.23516411460311636e-324);
diff --git a/t/op/inc.t b/t/op/inc.t
index 0bb8b85b13..3d5cc024d3 100644
--- a/t/op/inc.t
+++ b/t/op/inc.t
@@ -188,10 +188,10 @@ cmp_ok($a, '==', 2147483647, "postdecrement properly downgrades from double");
SKIP: {
if ($Config{uselongdouble} &&
- ($Config{long_double_style_ieee_doubledouble})) {
+ ($Config{d_long_double_style_ieee_doubledouble})) {
skip "the double-double format is weird", 1;
}
- unless ($Config{double_style_ieee}) {
+ unless ($Config{d_double_style_ieee}) {
skip "the doublekind $Config{doublekind} is not IEEE", 1;
}
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index bbc12ccd0a..38a550c281 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -701,7 +701,7 @@ SKIP: {
skip("uselongdouble=" . ($Config{uselongdouble} ? 'define' : 'undef')
. " longdblkind=$Config{longdblkind} os=$^O", 6)
unless ($Config{uselongdouble} &&
- ($Config{long_double_style_ieee_doubledouble})
+ ($Config{d_long_double_style_ieee_doubledouble})
# Gating on 'linux' (ppc) here is due to the differing
# double-double implementations: other (also big-endian)
# double-double platforms (e.g. AIX on ppc or IRIX on mips)
@@ -892,7 +892,7 @@ SKIP: {
skip("non-80-bit-long-double", 17)
unless ($Config{uselongdouble} &&
($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
- ($Config{long_double_style_ieee_extended}));
+ ($Config{d_long_double_style_ieee_extended}));
{
# The last normal for this format.
--
2.25.4

32
perl-5.33.4-locale.c-Fix-typo-in-ifdef.patch
View File

@ -1,32 +0,0 @@
From 9289d4dc7a3d24b20c6e25045e687321ee3e8faf Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 30 Nov 2020 09:25:52 -0700
Subject: [PATCH] locale.c: Fix typo in #ifdef
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This misspelling led to the code assuming that the platform didn't have
a feature that, if used, would result in faster execution.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
locale.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/locale.c b/locale.c
index 9500ab7960..5970423404 100644
--- a/locale.c
+++ b/locale.c
@@ -2621,7 +2621,7 @@ S_my_nl_langinfo(const int item, bool toggle)
#if defined(HAS_NL_LANGINFO) /* nl_langinfo() is available. */
# if ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \
|| ! defined(HAS_POSIX_2008_LOCALE) \
- || ! defined(DUPLOCALE)
+ || ! defined(HAS_DUPLOCALE)
/* Here, use plain nl_langinfo(), switching to the underlying LC_NUMERIC
* for those items dependent on it. This must be copied to a buffer before
--
2.26.2

140
perl-5.33.5-Fix-buggy-fc-in-Turkish-locale.patch
View File

@ -1,140 +0,0 @@
From 4cfbe5474a5c5f852a6dbf0138dc796c2800be93 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Wed, 30 Dec 2020 05:55:08 -0700
Subject: [PATCH] Fix buggy fc() in Turkish locale
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
When Turkish handling was added, fc() wasn't properly updated
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp.c | 12 +++++++++---
t/op/lc.t | 23 ++++++++++++++++-------
2 files changed, 25 insertions(+), 10 deletions(-)
diff --git a/pp.c b/pp.c
index 5e1706346d..23cc6c8adb 100644
--- a/pp.c
+++ b/pp.c
@@ -4813,7 +4813,7 @@ PP(pp_fc)
do {
extra++;
- s_peek = (U8 *) memchr(s_peek + 1, 'i',
+ s_peek = (U8 *) memchr(s_peek + 1, 'I',
send - (s_peek + 1));
} while (s_peek != NULL);
}
@@ -4828,8 +4828,14 @@ PP(pp_fc)
+ 1 /* Trailing NUL */ );
d = (U8*)SvPVX(dest) + len;
- *d++ = UTF8_TWO_BYTE_HI(GREEK_SMALL_LETTER_MU);
- *d++ = UTF8_TWO_BYTE_LO(GREEK_SMALL_LETTER_MU);
+ if (*s == 'I') {
+ *d++ = UTF8_TWO_BYTE_HI(LATIN_SMALL_LETTER_DOTLESS_I);
+ *d++ = UTF8_TWO_BYTE_LO(LATIN_SMALL_LETTER_DOTLESS_I);
+ }
+ else {
+ *d++ = UTF8_TWO_BYTE_HI(GREEK_SMALL_LETTER_MU);
+ *d++ = UTF8_TWO_BYTE_LO(GREEK_SMALL_LETTER_MU);
+ }
s++;
for (; s < send; s++) {
diff --git a/t/op/lc.t b/t/op/lc.t
index fce77f3d34..812c41d6b6 100644
--- a/t/op/lc.t
+++ b/t/op/lc.t
@@ -17,7 +17,7 @@ BEGIN {
use feature qw( fc );
-plan tests => 139 + 2 * (4 * 256) + 15;
+plan tests => 139 + 2 * (5 * 256) + 17;
is(lc(undef), "", "lc(undef) is ''");
is(lcfirst(undef), "", "lcfirst(undef) is ''");
@@ -352,13 +352,14 @@ foreach my $turkic (0 .. 1) {
my $locale = ($turkic) ? $turkic_locale : $non_turkic_locale;
SKIP: {
- skip "Can't find a $type UTF-8 locale", 4*256 unless defined $locale;
+ skip "Can't find a $type UTF-8 locale", 5*256 unless defined $locale;
use feature qw( unicode_strings );
no locale;
my @unicode_lc;
+ my @unicode_fc;
my @unicode_uc;
my @unicode_lcfirst;
my @unicode_ucfirst;
@@ -366,6 +367,7 @@ foreach my $turkic (0 .. 1) {
# Get all the values outside of 'locale'
for my $i (0 .. 255) {
push @unicode_lc, lc(chr $i);
+ push @unicode_fc, fc(chr $i);
push @unicode_uc, uc(chr $i);
push @unicode_lcfirst, lcfirst(chr $i);
push @unicode_ucfirst, ucfirst(chr $i);
@@ -373,6 +375,7 @@ foreach my $turkic (0 .. 1) {
if ($turkic) {
$unicode_lc[ord 'I'] = chr 0x131;
+ $unicode_fc[ord 'I'] = chr 0x131;
$unicode_lcfirst[ord 'I'] = chr 0x131;
$unicode_uc[ord 'i'] = chr 0x130;
$unicode_ucfirst[ord 'i'] = chr 0x130;
@@ -384,6 +387,7 @@ foreach my $turkic (0 .. 1) {
for my $i (0 .. 255) {
is(lc(chr $i), $unicode_lc[$i], "In a $type UTF-8 locale, lc(chr $i) is the same as official Unicode");
is(uc(chr $i), $unicode_uc[$i], "In a $type UTF-8 locale, uc(chr $i) is the same as official Unicode");
+ is(fc(chr $i), $unicode_fc[$i], "In a $type UTF-8 locale, fc(chr $i) is the same as official Unicode");
is(lcfirst(chr $i), $unicode_lcfirst[$i], "In a $type UTF-8 locale, lcfirst(chr $i) is the same as official Unicode");
is(ucfirst(chr $i), $unicode_ucfirst[$i], "In a $type UTF-8 locale, ucfirst(chr $i) is the same as official Unicode");
}
@@ -391,27 +395,32 @@ foreach my $turkic (0 .. 1) {
}
SKIP: {
- skip "Can't find a turkic UTF-8 locale", 15 unless defined $turkic_locale;
+ skip "Can't find a turkic UTF-8 locale", 17 unless defined $turkic_locale;
# These are designed to stress the calculation of space needed for the
# strings. $filler contains a variety of characters that have special
# handling in the casing functions, and some regular chars as well.
+ # (0x49 = 'I')
my $filler_length = 10000;
- my $filler = uni_to_native("\x{df}\x{b5}\x{e0}\x{c1}\x{b6}\x{ff}") x $filler_length;
+ my $filler = uni_to_native("\x{df}\x{49}\x{69}\x{b5}\x{e0}\x{c1}\x{b6}\x{ff}") x $filler_length;
# These are the correct answers to what should happen when the given
# casing function is called on $filler;
- my $filler_lc = uni_to_native("\x{df}\x{b5}\x{e0}\x{e1}\x{b6}\x{ff}") x $filler_length;
- my $filler_fc = ("ss" . uni_to_native("\x{b5}\x{e0}\x{e1}\x{b6}\x{ff}")) x $filler_length;
- my $filler_uc = ("SS" . uni_to_native("\x{39c}\x{c0}\x{c1}\x{b6}\x{178}")) x $filler_length;
+ my $filler_lc = uni_to_native("\x{df}\x{131}\x{69}\x{b5}\x{e0}\x{e1}\x{b6}\x{ff}") x $filler_length;
+ my $filler_fc = ("ss" . uni_to_native("\x{131}\x{69}\x{3bc}\x{e0}\x{e1}\x{b6}\x{ff}")) x $filler_length;
+ my $filler_uc = ("SS" . uni_to_native("\x{49}\x{130}\x{39c}\x{c0}\x{c1}\x{b6}\x{178}")) x $filler_length;
use locale;
setlocale(&POSIX::LC_CTYPE, $turkic_locale);
is (lc "IIIIIII$filler", "\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_lc",
"lc non-UTF-8, in Turkic locale, beginning with a bunch of I's");
+ is (fc "IIIIIII$filler", "\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_fc",
+ "fc non-UTF-8, in Turkic locale, beginning with a bunch of I's");
is (lc "${filler}IIIIIII$filler", "$filler_lc\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_lc",
"lc non-UTF-8, in Turkic locale, a bunch of I's, but not at the beginning");
+ is (fc "${filler}IIIIIII$filler", "$filler_fc\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_fc",
+ "fc non-UTF-8, in Turkic locale, a bunch of I's, but not at the beginning");
is (lc "${filler}I\x{307}$filler", "${filler_lc}i$filler_lc",
"lc in Turkic locale with DOT ABOVE immediately following I");
is (lc "${filler}I\x{307}IIIIII$filler", "${filler_lc}i\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_lc",
--
2.26.2

43
perl-5.33.5-Use-perl.h-versions-of-PERL_UNUSED_foo-in-XSUB.h.patch
View File

@ -1,43 +0,0 @@
From 036189b0a003875df7bf09c7f7fd702267f549e5 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sat, 26 Dec 2020 08:44:08 -0700
Subject: [PATCH] Use perl.h versions of PERL_UNUSED_foo in XSUB.h
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This commit was applied to perl.h, but not to XSUB.h:
commit a730e3f230f364cffe49370f816f975ae7c9c403
Author: Jarkko Hietaniemi <jhi@iki.fi>
Date: Thu Sep 4 09:08:33 2014 -0400
Use sizeof() in UNUSED_ARG and UNUSED_VAR to avoid accessing the values.
The values might even be uninitialized in the case of PERL_UNUSED_VAR.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
XSUB.h | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/XSUB.h b/XSUB.h
index 616d813840..c1e3959885 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -108,10 +108,10 @@ is a lexical C<$_> in scope.
*/
#ifndef PERL_UNUSED_ARG
-# define PERL_UNUSED_ARG(x) ((void)x)
+# define PERL_UNUSED_ARG(x) ((void)sizeof(x))
#endif
#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(x) ((void)x)
+# define PERL_UNUSED_VAR(x) ((void)sizeof(x))
#endif
#define ST(off) PL_stack_base[ax + (off)]
--
2.26.2

78
perl-5.33.5-op.c-croak-on-my-_-when-use-utf8-is-in-effect.patch
View File

@ -1,78 +0,0 @@
From 07319fdbb283f93cb655c3106b5237cbc7272038 Mon Sep 17 00:00:00 2001
From: Tomasz Konojacki <me@xenu.pl>
Date: Wed, 30 Dec 2020 14:03:02 +0100
Subject: [PATCH] op.c: croak on "my $_" when "use utf8" is in effect
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Fixes #18449
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
op.c | 16 +++++++++-------
t/op/mydef.t | 11 +++++++++--
2 files changed, 18 insertions(+), 9 deletions(-)
diff --git a/op.c b/op.c
index b2e12dd0c0..dce844d297 100644
--- a/op.c
+++ b/op.c
@@ -730,6 +730,7 @@ PADOFFSET
Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
{
PADOFFSET off;
+ bool is_idfirst, is_default;
const bool is_our = (PL_parser->in_my == KEY_our);
PERL_ARGS_ASSERT_ALLOCMY;
@@ -738,14 +739,15 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
Perl_croak(aTHX_ "panic: allocmy illegal flag bits 0x%" UVxf,
(UV)flags);
+ is_idfirst = flags & SVf_UTF8
+ ? isIDFIRST_utf8_safe((U8*)name + 1, name + len)
+ : isIDFIRST_A(name[1]);
+
+ /* $_, @_, etc. */
+ is_default = len == 2 && name[1] == '_';
+
/* complain about "my $<special_var>" etc etc */
- if ( len
- && !( is_our
- || isALPHA(name[1])
- || ( (flags & SVf_UTF8)
- && isIDFIRST_utf8_safe((U8 *)name+1, name + len))
- || (name[1] == '_' && len > 2)))
- {
+ if (!is_our && (!is_idfirst || is_default)) {
const char * const type =
PL_parser->in_my == KEY_sigvar ? "subroutine signature" :
PL_parser->in_my == KEY_state ? "\"state\"" : "\"my\"";
diff --git a/t/op/mydef.t b/t/op/mydef.t
index 42a81d9ab0..225ce98e51 100644
--- a/t/op/mydef.t
+++ b/t/op/mydef.t
@@ -6,10 +6,17 @@ BEGIN {
set_up_inc('../lib');
}
-plan tests => 1;
-
use strict;
eval 'my $_';
like $@, qr/^Can't use global \$_ in "my" at /;
+{
+ # using utf8 allows $_ to be declared with 'my'
+ # GH #18449
+ use utf8;
+ eval 'my $_;';
+ like $@, qr/^Can't use global \$_ in "my" at /;
+}
+
+done_testing;
--
2.26.2

100
perl-5.33.6-Add-missing-entries-to-perldiag-GH-18276.patch
View File

@ -1,100 +0,0 @@
From cac138107138a9814b32c4de74426225628f1646 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sun, 17 Jan 2021 21:45:20 -0700
Subject: [PATCH] Add missing entries to perldiag; GH #18276
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The ticket mentions yet another message, not addressed in this
commit, "Insecure private-use override". That message is part of a
hook for a so-far unimplemented module, so it actually doesn't ever get
raised.
Committer: One correction per Grinnz comment in
https://github.com/Perl/perl5/pull/18491
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pod/perldiag.pod | 45 +++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 45 insertions(+)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 9c91630d39..63f57f220e 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2195,6 +2195,20 @@ single form when it must operate on them directly. Either you've passed
an invalid file specification to Perl, or you've found a case the
conversion routines don't handle. Drat.
+=item Error %s in expansion of %s
+
+(F) An error was encountered in handling a user-defined property
+(L<perlunicode/User-Defined Character Properties>). These are
+programmer written subroutines, hence subject to errors that may
+prevent them from compiling or running. The calls to these subs are
+C<eval>'d, and if there is a failure, this message is raised, using the
+contents of C<$@> from the failed C<eval>.
+
+Another possibility is that tainted data was encountered somewhere in
+the chain of expanding the property. If so, the message wording will
+indicate that this is the problem. See L</Insecure user-defined
+property %s>.
+
=item Eval-group in insecure regular expression
(F) Perl detected tainted data when trying to compile a regular
@@ -2836,6 +2850,16 @@ not match 8 spaces.
text. You should check the pattern to ensure that recursive patterns
either consume text or fail.
+=item Infinite recursion in user-defined property
+
+(F) A user-defined property (L<perlunicode/User-Defined Character
+Properties>) can depend on the definitions of other user-defined
+properties. If the chain of dependencies leads back to this property,
+infinite recursion would occur, were it not for the check that raised
+this error.
+
+Restructure your property definitions to avoid this.
+
=item Infinite recursion via empty pattern
(F) You tried to use the empty pattern inside of a regex code block,
@@ -6273,6 +6297,20 @@ lexicals that are initialized only once (see L<feature>):
This use of C<my()> in a false conditional was deprecated beginning in
Perl 5.10 and became a fatal error in Perl 5.30.
+=item Timeout waiting for another thread to define \p{%s}
+
+(F) The first time a user-defined property
+(L<perlunicode/User-Defined Character Properties>) is used, its
+definition is looked up and converted into an internal form for more
+efficient handling in subsequent uses. There could be a race if two or
+more threads tried to do this processing nearly simultaneously.
+Instead, a critical section is created around this task, locking out all
+but one thread from doing it. This message indicates that the thread
+that is doing the conversion is taking an unexpectedly long time. The
+timeout exists solely to prevent deadlock; it's long enough that the
+system was likely thrashing and about to crash. There is no real remedy but
+rebooting.
+
=item times not implemented
(F) Your version of the C library apparently doesn't do times(). I
@@ -6846,6 +6884,13 @@ for the list of known options.
L<perlrun|perlrun/-C [numberE<sol>list]> documentation of the C<-C> switch
for the list of known options.
+=item Unknown user-defined property name \p{%s}
+
+(F) You specified to use a property within the C<\p{...}> which was a
+syntactically valid user-defined property, but no definition was found
+for it by the time one was required to proceed. Check your spelling.
+See L<perlunicode/User-Defined Character Properties>.
+
=item Unknown verb pattern '%s' in regex; marked by S<<-- HERE> in m/%s/
(F) You either made a typo or have incorrectly put a C<*> quantifier
--
2.26.2

32
perl-5.33.6-t-run-locale.t-Rmv-LANGUAGE-from-environment.patch
View File

@ -1,32 +0,0 @@
From a2f57b06b018b254bee93e1a1265cfc09833366f Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 9 Feb 2021 11:32:15 -0700
Subject: [PATCH] t/run/locale.t: Rmv LANGUAGE from environment
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This could cause interference with our tests on some platforms that have
this environment variable.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/run/locale.t | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/t/run/locale.t b/t/run/locale.t
index 8a04d1aea6..0f2a2ba457 100644
--- a/t/run/locale.t
+++ b/t/run/locale.t
@@ -38,7 +38,7 @@ if (defined $ARGV[0] && $ARGV[0] ne "") {
}
# reset the locale environment
-delete local @ENV{'LANG', (grep /^LC_[A-Z]+$/, keys %ENV)};
+delete local @ENV{'LANGUAGE', 'LANG', (grep /^LC_[A-Z]+$/, keys %ENV)};
# If user wants this to happen, they set the environment variable AND use
# 'debug'
--
2.26.2

74
perl-5.33.7-regcomp.c-Remove-memory-leak.patch
View File

@ -1,74 +0,0 @@
From 5f41fa466a67b5535aa8bcf4b814f242545ac7bd Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sat, 27 Feb 2021 11:43:41 -0700
Subject: [PATCH] regcomp.c: Remove memory leak
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This fixes GH #18604. There was a path through the code where a
particular SV did not get its reference count decremented.
I did an audit of the function and came up with several other
possiblities that are included in this commit.
Further, there would be leaks for some instances of finding syntax
errors in the input pattern, or when warnings are fatalized. Those
would require mortalizing some SVs, but that is beyond the scope of this
commit.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 7 +++++++
t/op/svleak.t | 3 ++-
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/regcomp.c b/regcomp.c
index e44c7a37e5..f5e5f581dc 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -18765,6 +18765,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
RExC_end = save_end;
RExC_in_multi_char_class = 0;
SvREFCNT_dec_NN(multi_char_matches);
+ SvREFCNT_dec(properties);
+ SvREFCNT_dec(cp_list);
+ SvREFCNT_dec(simple_posixes);
+ SvREFCNT_dec(posixes);
+ SvREFCNT_dec(nposixes);
+ SvREFCNT_dec(cp_foldable_list);
return ret;
}
@@ -20122,6 +20128,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
RExC_parse - orig_parse);;
SvREFCNT_dec(cp_list);;
SvREFCNT_dec(only_utf8_locale_list);
+ SvREFCNT_dec(upper_latin1_only_utf8_matches);
return ret;
}
diff --git a/t/op/svleak.t b/t/op/svleak.t
index 6acc298c3d..3df4838be8 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
use Config;
-plan tests => 150;
+plan tests => 151;
# run some code N times. If the number of SVs at the end of loop N is
# greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -278,6 +278,7 @@ eleak(2,0,'/[[:ascii:]]/');
eleak(2,0,'/[[.zog.]]/');
eleak(2,0,'/[.zog.]/');
eleak(2,0,'/|\W/', '/|\W/ [perl #123198]');
+eleak(2,0,'/a\sb/', '/a\sb/ [GH #18604]');
eleak(2,0,'no warnings; /(?[])/');
eleak(2,0,'no warnings; /(?[[a]+[b]])/');
eleak(2,0,'no warnings; /(?[[a]-[b]])/');
--
2.26.2

62
perl-5.33.8-Fix-broken-left-shift-of-IV_MIN-under-use-integer.patch
View File

@ -1,62 +0,0 @@
From 4e82c85b1c9c9b30253b8624470da6f20a6c0604 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 15 Mar 2021 21:01:47 -0600
Subject: [PATCH] Fix broken left shift of IV_MIN under 'use integer'
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This fixes GH 18639
When I wrote this code, I conflated casting and complementing.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp.c | 3 ---
t/op/bop.t | 9 ++++++++-
2 files changed, 8 insertions(+), 4 deletions(-)
diff --git a/pp.c b/pp.c
index d365afea4c..baf0777a47 100644
--- a/pp.c
+++ b/pp.c
@@ -2007,9 +2007,6 @@ static IV S_iv_shift(IV iv, int shift, bool left)
* 18446744073709551552
* */
if (left) {
- if (iv == IV_MIN) { /* Casting this to a UV is undefined behavior */
- return 0;
- }
return (IV) (((UV) iv) << shift);
}
diff --git a/t/op/bop.t b/t/op/bop.t
index 07f057d0a9..31b6531a03 100644
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -18,7 +18,7 @@ BEGIN {
# If you find tests are failing, please try adding names to tests to track
# down where the failure is, and supply your new names as a patch.
# (Just-in-time test naming)
-plan tests => 502;
+plan tests => 503;
# numerics
ok ((0xdead & 0xbeef) == 0x9ead);
@@ -33,6 +33,13 @@ ok ((33023 >> 7) == 257);
# signed vs. unsigned
ok ((~0 > 0 && do { use integer; ~0 } == -1));
+{ # GH #18639
+ my $iv_min = -(~0 >> 1) - 1;
+ my $shifted;
+ { use integer; $shifted = $iv_min << 0 };
+ is($shifted, $iv_min, "IV_MIN << 0 yields IV_MIN under 'use integer'");
+}
+
my $bits = 0;
for (my $i = ~0; $i; $i >>= 1) { ++$bits; }
my $cusp = 1 << ($bits - 1);
--
2.26.3

39
perl-5.36.0-Add-definition-of-OPTIMIZE-to-.ph-files.patch
View File

@ -1,39 +0,0 @@
From 6d9d949fb4962e32636aee48a948081d8936d318 Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jplesnik@redhat.com>
Date: Wed, 11 Jan 2023 09:12:18 +0100
Subject: [PATCH] Add definition of OPTIMIZE to .ph files
The fortify.h header includes a test to ensure that -O is used when
compiling with _FORTIFY_SOURCE, and the header looks for OPTIMIZE, which
is set by the compiler whenever -O is used. Perl translates this test
to the .ph file, but nothing ever sets OPTIMIZE. This causes a warning
for anything that uses features.ph.
_FORTIFY_SOURCE is defined in /usr/lib64/perl5/_h2ph_pre.ph which is
generated by h2ph. It uses value of @Config{'ccsymbols', 'cppsymbols',
'cppccsymbols'} which does not contain definition for OPTIMIZE.
The patch updated h2ph to add OPTIMIZE if -O is used.
---
utils/h2ph.PL | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index afa53c2..3950d11 100644
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -865,6 +865,11 @@ sub _extract_cc_defines
my $allsymbols = join " ",
@Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
+ # If optimizing -O2 is used, add the definition
+ if ($Config{'ccflags'} =~ /(?:\s+|^)-O([\d]+)(?:\s+|$)/) {
+ $allsymbols .= " __OPTIMIZE__=$1";
+ }
+
# Split compiler pre-definitions into 'key=value' pairs:
while ($allsymbols =~ /([^\s]+)=((\\\s|[^\s])+)/g) {
$define{$1} = $2;
--
2.39.0

6
perl.rpmlintrc
View File

@ -1,7 +1,5 @@
from Config import *
addFilter("spelling-error .* (autoloaded|awk|cacheout|closedir|decrement|exe|explicative|gdbm|getgr|gethost|getnet|getproto|getpw|getserv|globbing|gmtime|groff|ithreads|lexically|libnet|localtime|lstat|Memoizing|metapackage|ndbm|Nestable|nonprintable|odbm|opcodes|opendir|perlbug|perldoc|perlfunc|perlglob|perllocale|perldiag|perlmain|perlpod|perlsub|Pragma|prebuilt|predeclare|printables|reachability|readdir|redispatch|rewinddir|rpmbuild|sdbm|sed|splain|truncations|usr|writemain)");
addFilter("unexpanded-macro %description .* %(Extensions|INC)");
# POSIX module provides wrappers for libc functions
addFilter("missing-call-to-setgroups-before-setuid .*/auto/POSIX/POSIX.so");
addFilter("spelling-error .* (autoloaded|awk|gmtime|groff|libnet|localtime|Memoizing|metapackage|perlbug|perldoc|perlfunc|perlmain|perlpod|perlsub|reachability|rpmbuild|sed|splain|usr|writemain)");
addFilter("unexpanded-macro %description .* %INC");
# Applied with "git am"
addFilter("patch-not-applied Patch58: perl-5.30.0-PATCH-perl-134329-Use-after-free-in-regcomp.c.patch");