Remove patches merged into code of 5.16.
This commit is contained in:
Marcela Mašláňová
parent
2d8bd2eda5
commit
13e3016b98
@ -1,52 +0,0 @@
|
|||||||
From 7402016d87474403eea5c52dc2c071f68cbbe25c Mon Sep 17 00:00:00 2001
|
|
||||||
From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avar@cpan.org>
|
|
||||||
Date: Tue, 13 Dec 2011 14:43:12 +0000
|
|
||||||
Subject: [PATCH] [RT #78266] Don't leak memory when accessing named captures
|
|
||||||
that didn't match
|
|
||||||
|
|
||||||
Since 5.10 (probably 44a2ac759e) named captures have been leaking
|
|
||||||
memory when they're used, don't actually match, but are later
|
|
||||||
accessed. E.g.:
|
|
||||||
|
|
||||||
$ perl -wle 'for (1..10_000_000) { if ("foo" =~ /(foo|(?<capture>bar))?/) { my $capture = $+{capture} } } system "ps -o rss $$"'
|
|
||||||
RSS
|
|
||||||
238524
|
|
||||||
|
|
||||||
Here we match the "foo" branch of our regex, but since we've used a
|
|
||||||
name capture we'll end up running the code in
|
|
||||||
Perl_reg_named_buff_fetch, which allocates a newSVsv(&PL_sv_undef) but
|
|
||||||
never uses it unless it's trying to return an array.
|
|
||||||
|
|
||||||
Just change that code not to allocate scalars we don't plan to
|
|
||||||
return. With this fix we don't leak any memory since there's nothing
|
|
||||||
to leak anymore.
|
|
||||||
|
|
||||||
$ ./perl -Ilib -wle 'for (1..10_000_000) { if ("foo" =~ /(foo|(?<capture>bar))?/) { my $capture = $+{capture} } } system "ps -o rss $$"'
|
|
||||||
RSS
|
|
||||||
3528
|
|
||||||
|
|
||||||
This reverts commit b28f4af8cf94eb18c0cfde71e9625081912499a8 ("Fix
|
|
||||||
allocating something in the first place is a better solution than
|
|
||||||
allocating it, not using it, and then freeing it.
|
|
||||||
|
|
||||||
Petr Pisar: perldelta and wrong fix (commit b28f4af8cf) removed.
|
|
||||||
---
|
|
||||||
regcomp.c | 7 ++-----
|
|
||||||
|
|
||||||
diff --git a/regcomp.c b/regcomp.c
|
|
||||||
index 9e9fac4..56b2b9c 100644
|
|
||||||
--- a/regcomp.c
|
|
||||||
+++ b/regcomp.c
|
|
||||||
@@ -5409,7 +5409,8 @@ Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv,
|
|
||||||
if (!retarray)
|
|
||||||
return ret;
|
|
||||||
} else {
|
|
||||||
- ret = newSVsv(&PL_sv_undef);
|
|
||||||
+ if (retarray)
|
|
||||||
+ ret = newSVsv(&PL_sv_undef);
|
|
||||||
}
|
|
||||||
if (retarray)
|
|
||||||
av_push(retarray, ret);
|
|
||||||
--
|
|
||||||
1.7.7.4
|
|
||||||
|
|
||||||
@ -1,43 +0,0 @@
|
|||||||
From 38d7c791f597c3d567a70466dc2e48b73ec318bf Mon Sep 17 00:00:00 2001
|
|
||||||
From: Leon Timmermans <fawaka@gmail.com>
|
|
||||||
Date: Mon, 26 Dec 2011 19:06:54 +0200
|
|
||||||
Subject: [PATCH] Signal handlers must run before sigsuspend returns
|
|
||||||
|
|
||||||
The whole point of sigsuspend and pause is to wait until a signal has
|
|
||||||
arrived, and then return *after* it has been triggered. Currently
|
|
||||||
delayed/"safe" signals prevent that from happening, which might cause
|
|
||||||
race conditions.
|
|
||||||
|
|
||||||
This patch prevents that (as far as possible) by running the signal
|
|
||||||
handlers ASAP.
|
|
||||||
|
|
||||||
Petr Pisar: Back-ported to 5.14.2.
|
|
||||||
---
|
|
||||||
ext/POSIX/POSIX.xs | 4 ++++
|
|
||||||
1 files changed, 4 insertions(+), 0 deletions(-)
|
|
||||||
|
|
||||||
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
|
|
||||||
index 8dc1f5a..4b9779b 100644
|
|
||||||
--- a/ext/POSIX/POSIX.xs
|
|
||||||
+++ b/ext/POSIX/POSIX.xs
|
|
||||||
@@ -1550,6 +1550,8 @@ sigaction(sig, optaction, oldaction = 0)
|
|
||||||
SysRet
|
|
||||||
sigpending(sigset)
|
|
||||||
POSIX::SigSet sigset
|
|
||||||
+ CLEANUP:
|
|
||||||
+ PERL_ASYNC_CHECK();
|
|
||||||
|
|
||||||
SysRet
|
|
||||||
sigprocmask(how, sigset, oldsigset = 0)
|
|
||||||
@@ -2019,6 +2021,8 @@ pathconf(filename, name)
|
|
||||||
|
|
||||||
SysRet
|
|
||||||
pause()
|
|
||||||
+ CLEANUP:
|
|
||||||
+ PERL_ASYNC_CHECK();
|
|
||||||
|
|
||||||
SysRet
|
|
||||||
setgid(gid)
|
|
||||||
--
|
|
||||||
1.7.7.6
|
|
||||||
|
|
||||||
@ -1,54 +0,0 @@
|
|||||||
From 8ee4f541d4632a3615e70e177e004c5db970c8cd Mon Sep 17 00:00:00 2001
|
|
||||||
From: Father Chrysostomos <sprout@cpan.org>
|
|
||||||
Date: Fri, 3 Feb 2012 21:55:31 -0800
|
|
||||||
Subject: [PATCH] Stop !$^V from leaking
|
|
||||||
|
|
||||||
by mortalising the temporary SVs.
|
|
||||||
|
|
||||||
Petr Pisar: Back-port for 5.14.2.
|
|
||||||
---
|
|
||||||
t/op/svleak.t | 4 +++-
|
|
||||||
universal.c | 8 +++++++-
|
|
||||||
2 files changed, 10 insertions(+), 2 deletions(-)
|
|
||||||
|
|
||||||
diff --git a/t/op/svleak.t b/t/op/svleak.t
|
|
||||||
index 5eb090c..0f4348e 100644
|
|
||||||
--- a/t/op/svleak.t
|
|
||||||
+++ b/t/op/svleak.t
|
|
||||||
@@ -13,7 +13,7 @@ BEGIN {
|
|
||||||
or skip_all("XS::APItest not available");
|
|
||||||
}
|
|
||||||
|
|
||||||
-plan tests => 19;
|
|
||||||
+plan tests => 20;
|
|
||||||
|
|
||||||
# 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
|
|
||||||
@@ -141,3 +141,5 @@ leak(2, 0,
|
|
||||||
},
|
|
||||||
"rcatline leak"
|
|
||||||
);
|
|
||||||
+
|
|
||||||
+leak(2,0,sub { !$^V }, '[perl #109762] version object in boolean context');
|
|
||||||
diff --git a/universal.c b/universal.c
|
|
||||||
index 092ee80..9615d59 100644
|
|
||||||
--- a/universal.c
|
|
||||||
+++ b/universal.c
|
|
||||||
@@ -544,7 +544,13 @@ XS(XS_version_boolean)
|
|
||||||
SP -= items;
|
|
||||||
if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
|
|
||||||
SV * const lobj = SvRV(ST(0));
|
|
||||||
- SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
|
|
||||||
+ SV * const rs =
|
|
||||||
+ newSViv( vcmp(lobj,
|
|
||||||
+ sv_2mortal(new_version(
|
|
||||||
+ sv_2mortal(newSVpvs("0"))
|
|
||||||
+ ))
|
|
||||||
+ )
|
|
||||||
+ );
|
|
||||||
mPUSHs(rs);
|
|
||||||
PUTBACK;
|
|
||||||
return;
|
|
||||||
--
|
|
||||||
1.7.7.6
|
|
||||||
|
|
||||||
@ -1,36 +0,0 @@
|
|||||||
From be48bbe8d671b6841c3ec7cb734b98071afe3cd9 Mon Sep 17 00:00:00 2001
|
|
||||||
From: Chip <chip@pobox.com>
|
|
||||||
Date: Mon, 19 Sep 2011 23:51:49 -0700
|
|
||||||
Subject: [PATCH] add a couple missing LEAVEs in perlio_async_run()
|
|
||||||
|
|
||||||
---
|
|
||||||
perlio.c | 5 ++++-
|
|
||||||
1 files changed, 4 insertions(+), 1 deletions(-)
|
|
||||||
|
|
||||||
diff --git a/perlio.c b/perlio.c
|
|
||||||
index f0d67ae..79c6fdf 100644
|
|
||||||
--- a/perlio.c
|
|
||||||
+++ b/perlio.c
|
|
||||||
@@ -2563,8 +2563,10 @@ S_perlio_async_run(pTHX_ PerlIO* f) {
|
|
||||||
SAVEDESTRUCTOR_X(S_lockcnt_dec, (void*)f);
|
|
||||||
PerlIO_lockcnt(f)++;
|
|
||||||
PERL_ASYNC_CHECK();
|
|
||||||
- if ( !(PerlIOBase(f)->flags & PERLIO_F_CLEARED) )
|
|
||||||
+ if ( !(PerlIOBase(f)->flags & PERLIO_F_CLEARED) ) {
|
|
||||||
+ LEAVE;
|
|
||||||
return 0;
|
|
||||||
+ }
|
|
||||||
/* we've just run some perl-level code that could have done
|
|
||||||
* anything, including closing the file or clearing this layer.
|
|
||||||
* If so, free any lower layers that have already been
|
|
||||||
@@ -2576,6 +2578,7 @@ S_perlio_async_run(pTHX_ PerlIO* f) {
|
|
||||||
*f = l->next;
|
|
||||||
Safefree(l);
|
|
||||||
}
|
|
||||||
+ LEAVE;
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
--
|
|
||||||
1.7.7.4
|
|
||||||
|
|
||||||
@ -1,28 +0,0 @@
|
|||||||
From dbcab24bb98b4a243c8330bc7017c2080832b3f9 Mon Sep 17 00:00:00 2001
|
|
||||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
|
||||||
Date: Tue, 4 Oct 2011 13:46:39 +0200
|
|
||||||
Subject: [PATCH] Fix code injection in Digest
|
|
||||||
|
|
||||||
See <https://bugzilla.redhat.com/show_bug.cgi?id=743010> for more details.
|
|
||||||
---
|
|
||||||
cpan/Digest/Digest.pm | 4 +++-
|
|
||||||
1 files changed, 3 insertions(+), 1 deletions(-)
|
|
||||||
|
|
||||||
diff --git a/cpan/Digest/Digest.pm b/cpan/Digest/Digest.pm
|
|
||||||
index 384dfc8..4b923ae 100644
|
|
||||||
--- a/cpan/Digest/Digest.pm
|
|
||||||
+++ b/cpan/Digest/Digest.pm
|
|
||||||
@@ -35,7 +35,9 @@ sub new
|
|
||||||
($class, @args) = @$class if ref($class);
|
|
||||||
no strict 'refs';
|
|
||||||
unless (exists ${"$class\::"}{"VERSION"}) {
|
|
||||||
- eval "require $class";
|
|
||||||
+ my $pm_file = $class . ".pm";
|
|
||||||
+ $pm_file =~ s{::}{/}g;
|
|
||||||
+ eval { require $pm_file };
|
|
||||||
if ($@) {
|
|
||||||
$err ||= $@;
|
|
||||||
next;
|
|
||||||
--
|
|
||||||
1.7.6.4
|
|
||||||
|
|
||||||
@ -1,76 +0,0 @@
|
|||||||
From 647b6565b7d935eb9b92e057d0c7ae5fe54726e2 Mon Sep 17 00:00:00 2001
|
|
||||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
|
||||||
Date: Thu, 6 Oct 2011 16:35:49 +0200
|
|
||||||
Subject: [PATCH] Don't segfault given string repeat count larger than 2^31
|
|
||||||
|
|
||||||
E.g., this overflows INT_MAX and overruns heap memory:
|
|
||||||
|
|
||||||
$ perl -le 'print "v"x(2**31+1)'
|
|
||||||
[Exit 139 (SEGV)]
|
|
||||||
|
|
||||||
(Perl_repeatcpy): Use the same type for "count" as our sole
|
|
||||||
callers in pp.c: IV (long), not I32 (int). Otherwise, passing
|
|
||||||
the wider value to a narrower "I32 count"
|
|
||||||
|
|
||||||
http://thread.gmane.org/gmane.comp.lang.perl.perl5.porters/96812
|
|
||||||
https://rt.perl.org/rt3/Ticket/Display.html?id=94560
|
|
||||||
|
|
||||||
Original author: Jim Meyering <meyering@redhat.com>
|
|
||||||
Petr Pisar: Modify embed.fnc instead of generated proto.h
|
|
||||||
---
|
|
||||||
embed.fnc | 2 +-
|
|
||||||
util.c | 8 ++++----
|
|
||||||
2 files changed, 5 insertions(+), 5 deletions(-)
|
|
||||||
|
|
||||||
diff --git a/embed.fnc b/embed.fnc
|
|
||||||
index bce167e..8c86a3e 100644
|
|
||||||
--- a/embed.fnc
|
|
||||||
+++ b/embed.fnc
|
|
||||||
@@ -1032,7 +1032,7 @@ EXp |SV*|reg_qr_package|NN REGEXP * const rx
|
|
||||||
|
|
||||||
: FIXME - why the E?
|
|
||||||
Ep |void |regprop |NULLOK const regexp *prog|NN SV* sv|NN const regnode* o
|
|
||||||
-Anp |void |repeatcpy |NN char* to|NN const char* from|I32 len|I32 count
|
|
||||||
+Anp |void |repeatcpy |NN char* to|NN const char* from|I32 len|IV count
|
|
||||||
AnpP |char* |rninstr |NN const char* big|NN const char* bigend \
|
|
||||||
|NN const char* little|NN const char* lend
|
|
||||||
Ap |Sighandler_t|rsignal |int i|Sighandler_t t
|
|
||||||
diff --git a/util.c b/util.c
|
|
||||||
index 0ea39c6..3d4dcc7 100644
|
|
||||||
--- a/util.c
|
|
||||||
+++ b/util.c
|
|
||||||
@@ -3315,7 +3315,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
|
|
||||||
|
|
||||||
#define PERL_REPEATCPY_LINEAR 4
|
|
||||||
void
|
|
||||||
-Perl_repeatcpy(register char *to, register const char *from, I32 len, register I32 count)
|
|
||||||
+Perl_repeatcpy(register char *to, register const char *from, I32 len, register IV count)
|
|
||||||
{
|
|
||||||
PERL_ARGS_ASSERT_REPEATCPY;
|
|
||||||
|
|
||||||
@@ -3323,19 +3323,19 @@ Perl_repeatcpy(register char *to, register const char *from, I32 len, register I
|
|
||||||
memset(to, *from, count);
|
|
||||||
else if (count) {
|
|
||||||
register char *p = to;
|
|
||||||
- I32 items, linear, half;
|
|
||||||
+ IV items, linear, half;
|
|
||||||
|
|
||||||
linear = count < PERL_REPEATCPY_LINEAR ? count : PERL_REPEATCPY_LINEAR;
|
|
||||||
for (items = 0; items < linear; ++items) {
|
|
||||||
register const char *q = from;
|
|
||||||
- I32 todo;
|
|
||||||
+ IV todo;
|
|
||||||
for (todo = len; todo > 0; todo--)
|
|
||||||
*p++ = *q++;
|
|
||||||
}
|
|
||||||
|
|
||||||
half = count / 2;
|
|
||||||
while (items <= half) {
|
|
||||||
- I32 size = items * len;
|
|
||||||
+ IV size = items * len;
|
|
||||||
memcpy(p, to, size);
|
|
||||||
p += size;
|
|
||||||
items *= 2;
|
|
||||||
--
|
|
||||||
1.7.6.4
|
|
||||||
|
|
||||||
@ -1,26 +0,0 @@
|
|||||||
diff --git a/cpan/Unicode-Collate/Collate/Locale.pm b/cpan/Unicode-Collate/Collate/Locale.pm
|
|
||||||
index b26db00..35f4fb3 100644
|
|
||||||
--- a/cpan/Unicode-Collate/Collate/Locale.pm
|
|
||||||
+++ b/cpan/Unicode-Collate/Collate/Locale.pm
|
|
||||||
@@ -8,7 +8,6 @@ our $VERSION = '0.73';
|
|
||||||
|
|
||||||
use File::Spec;
|
|
||||||
|
|
||||||
-(my $ModPath = $INC{'Unicode/Collate/Locale.pm'}) =~ s/\.pm$//;
|
|
||||||
my $PL_EXT = '.pl';
|
|
||||||
|
|
||||||
my %LocaleFile = map { ($_, $_) } qw(
|
|
||||||
@@ -56,7 +55,12 @@ sub _fetchpl {
|
|
||||||
my $f = $LocaleFile{$accepted};
|
|
||||||
return if !$f;
|
|
||||||
$f .= $PL_EXT;
|
|
||||||
- my $path = File::Spec->catfile($ModPath, $f);
|
|
||||||
+ my $path;
|
|
||||||
+ for my $incpath (@INC) {
|
|
||||||
+ $path = File::Spec->catfile($incpath, 'Unicode', 'Collate', 'Locale', $f);
|
|
||||||
+ last if -f $path;
|
|
||||||
+ $path = undef;
|
|
||||||
+ }
|
|
||||||
my $h = do $path;
|
|
||||||
croak "Unicode/Collate/Locale/$f can't be found" if !$h;
|
|
||||||
return $h;
|
|
||||||
Loading…
Reference in New Issue
Block a user