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