Remove unnecessary patches
This commit is contained in:
parent
133f2d9408
commit
809d5c55f1
@ -1,60 +0,0 @@
|
||||
From 915ceb2f33469eeffd28cfb81ca52a05e1301f15 Mon Sep 17 00:00:00 2001
|
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||
Date: Fri, 14 Sep 2012 13:17:29 +0200
|
||||
Subject: [PATCH] Override the Pod::Simple::parse_file
|
||||
|
||||
This sets output_fh to STDOUT if it's not already set.
|
||||
This resolves CPANRT#77530 and RHBZ#826872 and is fixed in podlators-2.4.1.
|
||||
Ported to perl-5.14.2.
|
||||
---
|
||||
cpan/podlators/lib/Pod/Man.pm | 11 +++++++++++
|
||||
cpan/podlators/lib/Pod/Text.pm | 11 +++++++++++
|
||||
2 files changed, 22 insertions(+)
|
||||
|
||||
diff --git a/cpan/podlators/lib/Pod/Man.pm b/cpan/podlators/lib/Pod/Man.pm
|
||||
index 96f3fcc..ad5e5ac 100644
|
||||
--- a/cpan/podlators/lib/Pod/Man.pm
|
||||
+++ b/cpan/podlators/lib/Pod/Man.pm
|
||||
@@ -1302,6 +1302,17 @@ sub parse_from_filehandle {
|
||||
$self->parse_from_file (@_);
|
||||
}
|
||||
|
||||
+# Pod::Simple's parse_file doesn't set output_fh. Wrap the call and do so
|
||||
+# ourself unless it was already set by the caller, since our documentation has
|
||||
+# always said that this should work.
|
||||
+sub parse_file {
|
||||
+ my ($self, $in) = @_;
|
||||
+ unless (defined $$self{output_fh}) {
|
||||
+ $self->output_fh (\*STDOUT);
|
||||
+ }
|
||||
+ return $self->SUPER::parse_file ($in);
|
||||
+}
|
||||
+
|
||||
##############################################################################
|
||||
# Translation tables
|
||||
##############################################################################
|
||||
diff --git a/cpan/podlators/lib/Pod/Text.pm b/cpan/podlators/lib/Pod/Text.pm
|
||||
index cc02820..1a8b0bf 100644
|
||||
--- a/cpan/podlators/lib/Pod/Text.pm
|
||||
+++ b/cpan/podlators/lib/Pod/Text.pm
|
||||
@@ -679,6 +679,17 @@ sub parse_from_filehandle {
|
||||
$self->parse_from_file (@_);
|
||||
}
|
||||
|
||||
+# Pod::Simple's parse_file doesn't set output_fh. Wrap the call and do so
|
||||
+# ourself unless it was already set by the caller, since our documentation has
|
||||
+# always said that this should work.
|
||||
+sub parse_file {
|
||||
+ my ($self, $in) = @_;
|
||||
+ unless (defined $$self{output_fh}) {
|
||||
+ $self->output_fh (\*STDOUT);
|
||||
+ }
|
||||
+ return $self->SUPER::parse_file ($in);
|
||||
+}
|
||||
+
|
||||
##############################################################################
|
||||
# Module return value and documentation
|
||||
##############################################################################
|
||||
--
|
||||
1.7.11.4
|
||||
|
@ -1,94 +0,0 @@
|
||||
From 78787052b6a68c0f54cfa983a69c44276de9daa4 Mon Sep 17 00:00:00 2001
|
||||
From: Jesse Luehrs <doy@tozt.net>
|
||||
Date: Tue, 26 Jun 2012 00:13:54 -0500
|
||||
Subject: [PATCH] use a less broken test for locale radix in atof [perl #109318]
|
||||
|
||||
---
|
||||
lib/locale.t | 33 +++++++++++++++++++++++++++++++++
|
||||
numeric.c | 25 +++++++++++++++----------
|
||||
2 files changed, 48 insertions(+), 10 deletions(-)
|
||||
|
||||
diff --git a/lib/locale.t b/lib/locale.t
|
||||
index dfc6d2b..26a7bd4 100644
|
||||
--- a/lib/locale.t
|
||||
+++ b/lib/locale.t
|
||||
@@ -1247,6 +1247,39 @@ foreach $Locale (@Locale) {
|
||||
print "# failed $locales_test_number locale '$Locale' characters @f\n"
|
||||
}
|
||||
}
|
||||
+
|
||||
+ # [perl #109318]
|
||||
+ {
|
||||
+ my @f = ();
|
||||
+ ++$locales_test_number;
|
||||
+ $test_names{$locales_test_number} = 'Verify atof with locale radix and negative exponent';
|
||||
+
|
||||
+ my $radix = POSIX::localeconv()->{decimal_point};
|
||||
+ my @nums = (
|
||||
+ "3.14e+9", "3${radix}14e+9", "3.14e-9", "3${radix}14e-9",
|
||||
+ "-3.14e+9", "-3${radix}14e+9", "-3.14e-9", "-3${radix}14e-9",
|
||||
+ );
|
||||
+
|
||||
+ if (! $is_utf8_locale) {
|
||||
+ use locale;
|
||||
+ for my $num (@nums) {
|
||||
+ push @f, $num
|
||||
+ unless sprintf("%g", $num) =~ /3.+14/;
|
||||
+ }
|
||||
+ }
|
||||
+ else {
|
||||
+ use locale ':not_characters';
|
||||
+ for my $num (@nums) {
|
||||
+ push @f, $num
|
||||
+ unless sprintf("%g", $num) =~ /3.+14/;
|
||||
+ }
|
||||
+ }
|
||||
+
|
||||
+ tryneoalpha($Locale, $locales_test_number, @f == 0);
|
||||
+ if (@f) {
|
||||
+ print "# failed $locales_test_number locale '$Locale' numbers @f\n"
|
||||
+ }
|
||||
+ }
|
||||
}
|
||||
|
||||
my $final_locales_test_number = $locales_test_number;
|
||||
diff --git a/numeric.c b/numeric.c
|
||||
index be86f3a..3eb8a0e 100644
|
||||
--- a/numeric.c
|
||||
+++ b/numeric.c
|
||||
@@ -847,17 +847,22 @@ Perl_my_atof(pTHX_ const char* s)
|
||||
|
||||
PERL_ARGS_ASSERT_MY_ATOF;
|
||||
|
||||
- if (PL_numeric_local && IN_SOME_LOCALE_FORM) {
|
||||
- NV y;
|
||||
+ if (PL_numeric_local && PL_numeric_radix_sv && IN_SOME_LOCALE_FORM) {
|
||||
+ char *standard = NULL, *local = NULL;
|
||||
+ bool use_standard_radix;
|
||||
|
||||
- /* Scan the number twice; once using locale and once without;
|
||||
- * choose the larger result (in absolute value). */
|
||||
- Perl_atof2(s, x);
|
||||
- SET_NUMERIC_STANDARD();
|
||||
- Perl_atof2(s, y);
|
||||
- SET_NUMERIC_LOCAL();
|
||||
- if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
|
||||
- return y;
|
||||
+ standard = strchr(s, '.');
|
||||
+ local = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
|
||||
+
|
||||
+ use_standard_radix = standard && (!local || standard < local);
|
||||
+
|
||||
+ if (use_standard_radix)
|
||||
+ SET_NUMERIC_STANDARD();
|
||||
+
|
||||
+ Perl_atof2(s, x);
|
||||
+
|
||||
+ if (use_standard_radix)
|
||||
+ SET_NUMERIC_LOCAL();
|
||||
}
|
||||
else
|
||||
Perl_atof2(s, x);
|
||||
--
|
||||
1.7.4.1
|
||||
|
@ -1,46 +0,0 @@
|
||||
From a3ff80c12c16886edf9acdd3d172798e50defdb3 Mon Sep 17 00:00:00 2001
|
||||
From: Eric Brine <ikegami@adaelis.com>
|
||||
Date: Mon, 18 Jun 2012 14:56:32 -0400
|
||||
Subject: [PATCH] RT#113730 - $@ should be cleared on "do" IO error.
|
||||
|
||||
---
|
||||
pp_ctl.c | 1 +
|
||||
t/op/do.t | 12 ++++++++++++
|
||||
2 files changed, 13 insertions(+)
|
||||
|
||||
diff --git a/pp_ctl.c b/pp_ctl.c
|
||||
index b414e81..437bc8f 100644
|
||||
--- a/pp_ctl.c
|
||||
+++ b/pp_ctl.c
|
||||
@@ -3928,6 +3928,7 @@ PP(pp_require)
|
||||
DIE(aTHX_ "Can't locate %s", name);
|
||||
}
|
||||
|
||||
+ CLEAR_ERRSV();
|
||||
RETPUSHUNDEF;
|
||||
}
|
||||
else
|
||||
diff --git a/t/op/do.t b/t/op/do.t
|
||||
index 93d3f73..c5a5905 100644
|
||||
--- a/t/op/do.t
|
||||
+++ b/t/op/do.t
|
||||
@@ -286,4 +286,16 @@ SKIP: {
|
||||
is($w, undef, 'do STRING does not propagate warning hints');
|
||||
}
|
||||
|
||||
+# RT#113730 - $@ should be cleared on IO error.
|
||||
+{
|
||||
+ $@ = "should not see";
|
||||
+ $! = 0;
|
||||
+ my $rv = do("some nonexistent file");
|
||||
+ my $saved_error = $@;
|
||||
+ my $saved_errno = $!;
|
||||
+ ok(!$rv, "do returns false on io errror");
|
||||
+ ok(!$saved_error, "\$\@ not set on io error");
|
||||
+ ok($saved_errno, "\$! set on io error");
|
||||
+}
|
||||
+
|
||||
done_testing();
|
||||
--
|
||||
1.7.11.4
|
||||
|
@ -1,116 +0,0 @@
|
||||
From d546938a7c8b111c463b733910db885b24724b42 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Thu, 20 Sep 2012 06:24:25 -0700
|
||||
Subject: [PATCH] require 1 << 2
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Port to 5.16.1:
|
||||
|
||||
commit c31f6d3b869d78bbd101e694fd3b384b47a77f6d
|
||||
Author: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Thu Sep 20 06:24:25 2012 -0700
|
||||
|
||||
[perl #105924] require 1 << 2
|
||||
|
||||
Setting PL_expect after force_next has no effect, as force_next
|
||||
(called by force_version and force_word) picks up the current value of
|
||||
PL_expect and arranges for it to be reset thereto after the forced
|
||||
token is force-fed to the parser.
|
||||
|
||||
The KEY_require case should be setting PL_expect to XTERM (as it
|
||||
already does) when there is no forced token (version or bareword),
|
||||
because we expect a term after ‘require’, but to XOPERATOR when
|
||||
there is a forced token, because we expect an operator after that
|
||||
forced token.
|
||||
|
||||
Since the PL_expect assignment has no effect after force_next, we can
|
||||
set it to XOPERATOR before calling potentially calling force_next, and
|
||||
then to XTERM afterwards.
|
||||
|
||||
Loop exits had the same bug, so this fixes them all.
|
||||
---
|
||||
t/base/lex.t | 10 +++++++++-
|
||||
toke.c | 6 ++++++
|
||||
2 files changed, 15 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/t/base/lex.t b/t/base/lex.t
|
||||
index ce16ef1..c2a6cc3 100644
|
||||
--- a/t/base/lex.t
|
||||
+++ b/t/base/lex.t
|
||||
@@ -1,6 +1,6 @@
|
||||
#!./perl
|
||||
|
||||
-print "1..57\n";
|
||||
+print "1..63\n";
|
||||
|
||||
$x = 'x';
|
||||
|
||||
@@ -273,3 +273,11 @@ $test++;
|
||||
@a = (1,2,3);
|
||||
print "not " unless($a[~~2] == 3);
|
||||
print "ok 57\n";
|
||||
+
|
||||
+$test = 58;
|
||||
+for(qw< require goto last next redo dump >) {
|
||||
+ eval "sub { $_ foo << 2 }";
|
||||
+ print "not " if $@;
|
||||
+ print "ok ", $test++, " - [perl #105924] $_ WORD << ...\n";
|
||||
+ print "# $@" if $@;
|
||||
+}
|
||||
diff --git a/toke.c b/toke.c
|
||||
index 1d18550..aa2c3b6 100644
|
||||
--- a/toke.c
|
||||
+++ b/toke.c
|
||||
@@ -7344,6 +7344,7 @@ Perl_yylex(pTHX)
|
||||
UNI(OP_DBMCLOSE);
|
||||
|
||||
case KEY_dump:
|
||||
+ PL_expect = XOPERATOR;
|
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE);
|
||||
LOOPX(OP_DUMP);
|
||||
|
||||
@@ -7476,6 +7477,7 @@ Perl_yylex(pTHX)
|
||||
LOP(OP_GREPSTART, XREF);
|
||||
|
||||
case KEY_goto:
|
||||
+ PL_expect = XOPERATOR;
|
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE);
|
||||
LOOPX(OP_GOTO);
|
||||
|
||||
@@ -7598,6 +7600,7 @@ Perl_yylex(pTHX)
|
||||
LOP(OP_KILL,XTERM);
|
||||
|
||||
case KEY_last:
|
||||
+ PL_expect = XOPERATOR;
|
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE);
|
||||
LOOPX(OP_LAST);
|
||||
|
||||
@@ -7695,6 +7698,7 @@ Perl_yylex(pTHX)
|
||||
OPERATOR(MY);
|
||||
|
||||
case KEY_next:
|
||||
+ PL_expect = XOPERATOR;
|
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE);
|
||||
LOOPX(OP_NEXT);
|
||||
|
||||
@@ -7880,6 +7884,7 @@ Perl_yylex(pTHX)
|
||||
|
||||
case KEY_require:
|
||||
s = SKIPSPACE1(s);
|
||||
+ PL_expect = XOPERATOR;
|
||||
if (isDIGIT(*s)) {
|
||||
s = force_version(s, FALSE);
|
||||
}
|
||||
@@ -7911,6 +7916,7 @@ Perl_yylex(pTHX)
|
||||
UNI(OP_RESET);
|
||||
|
||||
case KEY_redo:
|
||||
+ PL_expect = XOPERATOR;
|
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE);
|
||||
LOOPX(OP_REDO);
|
||||
|
||||
--
|
||||
1.7.11.4
|
||||
|
@ -1,32 +0,0 @@
|
||||
From f9344c91a4ca48288bba30dc94a2d712d0659670 Mon Sep 17 00:00:00 2001
|
||||
From: Oleg Nesterov <oleg@redhat.com>
|
||||
Date: Wed, 4 Jul 2012 08:21:15 -0700
|
||||
Subject: [PATCH] [perl #113980] pp_syscall: "I32 retval" truncates the
|
||||
returned value
|
||||
|
||||
I noticed today that syscall(9, ...) (mmap) doesn't work for me.
|
||||
|
||||
The problem is obvious, pp_syscall() uses I32 for retval and the
|
||||
"long" address doesn't fit into "int".
|
||||
|
||||
The one-liner below should fix the problem.
|
||||
---
|
||||
pp_sys.c | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/pp_sys.c b/pp_sys.c
|
||||
index fb93732..c5d63ac 100644
|
||||
--- a/pp_sys.c
|
||||
+++ b/pp_sys.c
|
||||
@@ -5456,7 +5456,7 @@ PP(pp_syscall)
|
||||
register I32 items = SP - MARK;
|
||||
unsigned long a[20];
|
||||
register I32 i = 0;
|
||||
- I32 retval = -1;
|
||||
+ IV retval = -1;
|
||||
|
||||
if (PL_tainting) {
|
||||
while (++MARK <= SP) {
|
||||
--
|
||||
1.7.11.4
|
||||
|
@ -1,77 +0,0 @@
|
||||
From 13f27cb3dee86772eeed5d7d9b47746395ee603c Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Wed, 19 Sep 2012 21:53:51 -0700
|
||||
Subject: [PATCH] Stop my vars with attrs from leaking
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.16.1:
|
||||
|
||||
commit 9fa29fa7929b4167c5491b792c5cc7e4365a2839
|
||||
Author: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Wed Sep 19 21:53:51 2012 -0700
|
||||
|
||||
[perl #114764] Stop my vars with attrs from leaking
|
||||
|
||||
S_apply_attrs was creating a SV containing a stash name, that was
|
||||
later to be put in a const op, which would take care of freeing it.
|
||||
But it didn’t free it for a my variable, because the branch where that
|
||||
const op was created didn’t apply. So move the creation of that SV
|
||||
inside the branch that uses it, otherwise it leaks. This leak was the
|
||||
result of commit 95f0a2f1ffc6.
|
||||
---
|
||||
op.c | 4 ++--
|
||||
t/op/svleak.t | 5 ++++-
|
||||
2 files changed, 6 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/op.c b/op.c
|
||||
index 24d5ecb..017580d 100644
|
||||
--- a/op.c
|
||||
+++ b/op.c
|
||||
@@ -2279,13 +2279,11 @@ STATIC void
|
||||
S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
|
||||
{
|
||||
dVAR;
|
||||
- SV *stashsv;
|
||||
|
||||
PERL_ARGS_ASSERT_APPLY_ATTRS;
|
||||
|
||||
/* fake up C<use attributes $pkg,$rv,@attrs> */
|
||||
ENTER; /* need to protect against side-effects of 'use' */
|
||||
- stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
|
||||
|
||||
#define ATTRSMODULE "attributes"
|
||||
#define ATTRSMODULE_PM "attributes.pm"
|
||||
@@ -2300,6 +2298,8 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
|
||||
newSVpvs(ATTRSMODULE), NULL);
|
||||
}
|
||||
else {
|
||||
+ SV * const stashsv =
|
||||
+ stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
|
||||
Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
|
||||
newSVpvs(ATTRSMODULE),
|
||||
NULL,
|
||||
diff --git a/t/op/svleak.t b/t/op/svleak.t
|
||||
index df10953..6cfee2e 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 => 21;
|
||||
+plan tests => 22;
|
||||
|
||||
# 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
|
||||
@@ -160,3 +160,6 @@ leak(2, 0,
|
||||
}
|
||||
|
||||
leak(2,0,sub { !$^V }, '[perl #109762] version object in boolean context');
|
||||
+
|
||||
+# [perl #114764] Attributes leak scalars
|
||||
+leak(2, 0, sub { eval 'my $x : shared' }, 'my $x :shared used to leak');
|
||||
--
|
||||
1.7.11.4
|
||||
|
@ -1,76 +0,0 @@
|
||||
From a6636b43dc409e4b49f369c18fedd34332fdb9ab Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Thu, 20 Sep 2012 14:25:38 -0700
|
||||
Subject: [PATCH] [perl #114984] Glob.xs: Extend stack when returning
|
||||
|
||||
If a pattern passed to File::Glob consists of a space-separated list
|
||||
of patterns, the stack will only be extended by doglob() enough for
|
||||
the list returned by each subpattern. So iterate() needs to extend
|
||||
the stack before copying the list of files from an AV to the stack.
|
||||
|
||||
This fixes a regression introduced in 5.16.0.
|
||||
---
|
||||
MANIFEST | 1 +
|
||||
ext/File-Glob/Glob.xs | 1 +
|
||||
ext/File-Glob/t/rt114984.t | 25 +++++++++++++++++++++++++
|
||||
3 files changed, 27 insertions(+)
|
||||
create mode 100644 ext/File-Glob/t/rt114984.t
|
||||
|
||||
diff --git a/MANIFEST b/MANIFEST
|
||||
index a7935fc..cceb00e 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -3748,6 +3748,7 @@ ext/File-Glob/t/basic.t See if File::Glob works
|
||||
ext/File-Glob/t/case.t See if File::Glob works
|
||||
ext/File-Glob/t/global.t See if File::Glob works
|
||||
ext/File-Glob/TODO File::Glob extension todo list
|
||||
+ext/File-Glob/t/rt114984.t See if File::Glob works
|
||||
ext/File-Glob/t/taint.t See if File::Glob works
|
||||
ext/GDBM_File/GDBM_File.pm GDBM extension Perl module
|
||||
ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines
|
||||
diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs
|
||||
index 3ea0590..d74e7a4 100644
|
||||
--- a/ext/File-Glob/Glob.xs
|
||||
+++ b/ext/File-Glob/Glob.xs
|
||||
@@ -93,6 +93,7 @@ iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, SV *patsv))
|
||||
/* chuck it all out, quick or slow */
|
||||
if (gimme == G_ARRAY) {
|
||||
if (!on_stack) {
|
||||
+ EXTEND(SP, AvFILLp(entries)+1);
|
||||
Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *);
|
||||
SP += AvFILLp(entries)+1;
|
||||
}
|
||||
diff --git a/ext/File-Glob/t/rt114984.t b/ext/File-Glob/t/rt114984.t
|
||||
new file mode 100644
|
||||
index 0000000..4229c6b
|
||||
--- /dev/null
|
||||
+++ b/ext/File-Glob/t/rt114984.t
|
||||
@@ -0,0 +1,25 @@
|
||||
+use strict;
|
||||
+use warnings;
|
||||
+use v5.16.0;
|
||||
+use File::Temp 'tempdir';
|
||||
+use File::Spec::Functions;
|
||||
+use Test::More tests => 1;
|
||||
+
|
||||
+my @md = (1..305);
|
||||
+my @mp = (1000..1205);
|
||||
+
|
||||
+my $path = tempdir uc cleanup => 1;
|
||||
+
|
||||
+foreach (@md) {
|
||||
+ open(my $f, ">", catfile $path, "md_$_.dat");
|
||||
+ close $f;
|
||||
+}
|
||||
+
|
||||
+foreach (@mp) {
|
||||
+ open(my $f, ">", catfile $path, "mp_$_.dat");
|
||||
+ close $f;
|
||||
+}
|
||||
+my @b = glob(qq{$path/mp_[0123456789]*.dat
|
||||
+ $path/md_[0123456789]*.dat});
|
||||
+is scalar(@b), @md+@mp,
|
||||
+ 'File::Glob extends the stack when returning a long list';
|
||||
--
|
||||
1.7.11.4
|
||||
|
@ -1,75 +0,0 @@
|
||||
Ported to 5.16.1:
|
||||
|
||||
From 4505a31f43ca4e1a0e9203b389f6d4bebab9d899 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Tue, 9 Oct 2012 20:47:18 -0700
|
||||
Subject: [PATCH] =?UTF-8?q?[perl=20#115206]=20Don=E2=80=99t=20crash=20when=20?=
|
||||
=?UTF-8?q?vivifying=20$|?=
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
It was trying to read the currently-selected handle without checking
|
||||
whether it was selected. It is actually not necessary to initialise
|
||||
the variable this way, as the next use of get-magic on it will clobber
|
||||
the cached value.
|
||||
|
||||
This initialisation was originally added in commit d8ce0c9a45. The
|
||||
bug it was fixing was probably caused by missing FETCH calls that are
|
||||
no longer missing.
|
||||
---
|
||||
gv.c | 5 +----
|
||||
t/op/magic.t | 5 ++++-
|
||||
2 files changed, 5 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/gv.c b/gv.c
|
||||
index f352452..cf02ca4 100644
|
||||
--- a/gv.c
|
||||
+++ b/gv.c
|
||||
@@ -1913,10 +1913,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
|
||||
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
|
||||
"$%c is no longer supported", *name);
|
||||
break;
|
||||
- case '|': /* $| */
|
||||
- sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
|
||||
- goto magicalize;
|
||||
-
|
||||
case '\010': /* $^H */
|
||||
{
|
||||
HV *const hv = GvHVn(gv);
|
||||
@@ -1957,6 +1953,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
|
||||
case '>': /* $> */
|
||||
case '\\': /* $\ */
|
||||
case '/': /* $/ */
|
||||
+ case '|': /* $| */
|
||||
case '$': /* $$ */
|
||||
case '\001': /* $^A */
|
||||
case '\003': /* $^C */
|
||||
diff --git a/t/op/magic.t b/t/op/magic.t
|
||||
index 3fb1ea1..1bcfbd9 100644
|
||||
--- a/t/op/magic.t
|
||||
+++ b/t/op/magic.t
|
||||
@@ -5,7 +5,7 @@ BEGIN {
|
||||
chdir 't' if -d 't';
|
||||
@INC = '../lib';
|
||||
require './test.pl';
|
||||
- plan (tests => 156);
|
||||
+ plan (tests => 157);
|
||||
}
|
||||
|
||||
# Test that defined() returns true for magic variables created on the fly,
|
||||
@@ -581,6 +581,11 @@ SKIP: {
|
||||
}
|
||||
}
|
||||
|
||||
+# $|
|
||||
+fresh_perl_is
|
||||
+ 'select f; undef *f; ${q/|/}; print STDOUT qq|ok\n|', "ok\n", {},
|
||||
+ '[perl #115206] no crash when vivifying $| while *{+select}{IO} is undef';
|
||||
+
|
||||
# ^^^^^^^^^ New tests go here ^^^^^^^^^
|
||||
|
||||
SKIP: {
|
||||
--
|
||||
1.7.7.6
|
||||
|
@ -1,80 +0,0 @@
|
||||
From a6a40029a3cbad2c7d9b39cec86b9dc4baf428a9 Mon Sep 17 00:00:00 2001
|
||||
From: Dominic Hargreaves <dom@earth.li>
|
||||
Date: Tue, 20 Dec 2011 22:19:45 +0000
|
||||
Subject: [PATCH 1/4] cpan/CPAN: add NAME headings in modules with POD
|
||||
|
||||
This fixes the Debian Lintian warning about missing NAME sections in
|
||||
manpages.
|
||||
|
||||
Bug-Debian: http://bugs.debian.org/650448
|
||||
|
||||
Patch-Name: fixes/manpage_name_CPAN.diff
|
||||
---
|
||||
cpan/CPAN/lib/CPAN/Debug.pm | 4 ++++
|
||||
cpan/CPAN/lib/CPAN/HandleConfig.pm | 6 ++++++
|
||||
cpan/CPAN/lib/CPAN/Queue.pm | 4 ++++
|
||||
cpan/CPAN/lib/CPAN/Tarzip.pm | 4 ++++
|
||||
4 files changed, 18 insertions(+), 0 deletions(-)
|
||||
|
||||
diff --git a/cpan/CPAN/lib/CPAN/Debug.pm b/cpan/CPAN/lib/CPAN/Debug.pm
|
||||
index 23c4a36..48e394b 100644
|
||||
--- a/cpan/CPAN/lib/CPAN/Debug.pm
|
||||
+++ b/cpan/CPAN/lib/CPAN/Debug.pm
|
||||
@@ -71,6 +71,10 @@ sub debug {
|
||||
|
||||
__END__
|
||||
|
||||
+=head1 NAME
|
||||
+
|
||||
+CPAN::Debug - internal debugging for CPAN.pm
|
||||
+
|
||||
=head1 LICENSE
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm b/cpan/CPAN/lib/CPAN/HandleConfig.pm
|
||||
index 58ccbe5..bab607d 100644
|
||||
--- a/cpan/CPAN/lib/CPAN/HandleConfig.pm
|
||||
+++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm
|
||||
@@ -6,6 +6,12 @@ use File::Spec ();
|
||||
use File::Basename ();
|
||||
use Carp ();
|
||||
|
||||
+=head1 NAME
|
||||
+
|
||||
+CPAN::HandleConfig - internal configuration handling for CPAN.pm
|
||||
+
|
||||
+=cut
|
||||
+
|
||||
$VERSION = "5.5003"; # see also CPAN::Config::VERSION at end of file
|
||||
|
||||
%can = (
|
||||
diff --git a/cpan/CPAN/lib/CPAN/Queue.pm b/cpan/CPAN/lib/CPAN/Queue.pm
|
||||
index e5d88ce..1222b37 100644
|
||||
--- a/cpan/CPAN/lib/CPAN/Queue.pm
|
||||
+++ b/cpan/CPAN/lib/CPAN/Queue.pm
|
||||
@@ -201,6 +201,10 @@ sub reqtype_of {
|
||||
|
||||
__END__
|
||||
|
||||
+=head1 NAME
|
||||
+
|
||||
+CPAN::Queue - internal queue support for CPAN.pm
|
||||
+
|
||||
=head1 LICENSE
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
diff --git a/cpan/CPAN/lib/CPAN/Tarzip.pm b/cpan/CPAN/lib/CPAN/Tarzip.pm
|
||||
index 972df6c..cf8aad4 100644
|
||||
--- a/cpan/CPAN/lib/CPAN/Tarzip.pm
|
||||
+++ b/cpan/CPAN/lib/CPAN/Tarzip.pm
|
||||
@@ -450,6 +450,10 @@ END
|
||||
|
||||
__END__
|
||||
|
||||
+=head1 NAME
|
||||
+
|
||||
+CPAN::Tarzip - internal handling of tar archives for CPAN.pm
|
||||
+
|
||||
=head1 LICENSE
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
@ -1,60 +0,0 @@
|
||||
From 677ffc8fe97148750054b11e7fbd21c98f860ee1 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Fri, 21 Sep 2012 18:23:20 -0700
|
||||
Subject: [PATCH] =?UTF-8?q?Don=E2=80=99t=20leak=20deleted=20iterator=20whe?=
|
||||
=?UTF-8?q?n=20tying=20hash?=
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Petr Pisar: ported to 5.16.3
|
||||
---
|
||||
pp_sys.c | 7 +++++++
|
||||
t/op/tie.t | 13 +++++++++++++
|
||||
2 files changed, 20 insertions(+)
|
||||
|
||||
diff --git a/pp_sys.c b/pp_sys.c
|
||||
index 034a2d0..0e35d59 100644
|
||||
--- a/pp_sys.c
|
||||
+++ b/pp_sys.c
|
||||
@@ -852,9 +852,16 @@ PP(pp_tie)
|
||||
|
||||
switch(SvTYPE(varsv)) {
|
||||
case SVt_PVHV:
|
||||
+ {
|
||||
+ HE *entry;
|
||||
methname = "TIEHASH";
|
||||
+ if (HvLAZYDEL(varsv) && (entry = HvEITER((HV *)varsv))) {
|
||||
+ HvLAZYDEL_off(varsv);
|
||||
+ hv_free_ent((HV *)varsv, entry);
|
||||
+ }
|
||||
HvEITER_set(MUTABLE_HV(varsv), 0);
|
||||
break;
|
||||
+ }
|
||||
case SVt_PVAV:
|
||||
methname = "TIEARRAY";
|
||||
if (!AvREAL(varsv)) {
|
||||
diff --git a/t/op/tie.t b/t/op/tie.t
|
||||
index 9301bb3..5a536b8 100644
|
||||
--- a/t/op/tie.t
|
||||
+++ b/t/op/tie.t
|
||||
@@ -1259,3 +1259,16 @@ $h{i}{j} = 'k';
|
||||
print $h{i}{j}, "\n";
|
||||
EXPECT
|
||||
k
|
||||
+########
|
||||
+
|
||||
+# NAME Test that tying a hash does not leak a deleted iterator
|
||||
+# This produced unbalanced string table warnings under
|
||||
+# PERL_DESTRUCT_LEVEL=2.
|
||||
+package l {
|
||||
+ sub TIEHASH{bless[]}
|
||||
+}
|
||||
+$h = {foo=>0};
|
||||
+each %$h;
|
||||
+delete $$h{foo};
|
||||
+tie %$h, 'l';
|
||||
+EXPECT
|
||||
--
|
||||
1.8.1.4
|
||||
|
@ -1,109 +0,0 @@
|
||||
From f5488561bdaab57380bf07e8e66778503a41aca3 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Sun, 23 Sep 2012 12:42:15 -0700
|
||||
Subject: [PATCH] =?UTF-8?q?Don=E2=80=99t=20leak=20if=20hh=20copying=20dies?=
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
When %^H is copied on entering a new scope, if it happens to have been
|
||||
tied it can die. This was resulting in leaks, because no protections
|
||||
were added to handle that case.
|
||||
|
||||
The two things that were leaking were the new hash in hv_copy_hints_hv
|
||||
and the new value (for an element) in newSVsv.
|
||||
|
||||
By fixing newSVsv itself, this also fixes any potential leaks when
|
||||
other pieces of code call newSVsv on explosive values.
|
||||
|
||||
Petr Pisar: Ported to 5.16.3
|
||||
---
|
||||
hv.c | 6 ++++++
|
||||
sv.c | 7 ++++---
|
||||
t/op/svleak.t | 22 +++++++++++++++++++++-
|
||||
3 files changed, 31 insertions(+), 4 deletions(-)
|
||||
|
||||
diff --git a/hv.c b/hv.c
|
||||
index 3c35341..29d6352 100644
|
||||
--- a/hv.c
|
||||
+++ b/hv.c
|
||||
@@ -1440,6 +1440,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
|
||||
const I32 riter = HvRITER_get(ohv);
|
||||
HE * const eiter = HvEITER_get(ohv);
|
||||
|
||||
+ ENTER;
|
||||
+ SAVEFREESV(hv);
|
||||
+
|
||||
while (hv_max && hv_max + 1 >= hv_fill * 2)
|
||||
hv_max = hv_max / 2;
|
||||
HvMAX(hv) = hv_max;
|
||||
@@ -1461,6 +1464,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
|
||||
}
|
||||
HvRITER_set(ohv, riter);
|
||||
HvEITER_set(ohv, eiter);
|
||||
+
|
||||
+ SvREFCNT_inc_simple_void_NN(hv);
|
||||
+ LEAVE;
|
||||
}
|
||||
hv_magic(hv, NULL, PERL_MAGIC_hints);
|
||||
return hv;
|
||||
diff --git a/sv.c b/sv.c
|
||||
index a43feac..597d71b 100644
|
||||
--- a/sv.c
|
||||
+++ b/sv.c
|
||||
@@ -8764,11 +8764,12 @@ Perl_newSVsv(pTHX_ register SV *const old)
|
||||
Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
|
||||
return NULL;
|
||||
}
|
||||
+ /* Do this here, otherwise we leak the new SV if this croaks. */
|
||||
+ SvGETMAGIC(old);
|
||||
new_SV(sv);
|
||||
- /* SV_GMAGIC is the default for sv_setv()
|
||||
- SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
|
||||
+ /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
|
||||
with SvTEMP_off and SvTEMP_on round a call to sv_setsv. */
|
||||
- sv_setsv_flags(sv, old, SV_GMAGIC | SV_NOSTEAL);
|
||||
+ sv_setsv_flags(sv, old, SV_NOSTEAL);
|
||||
return sv;
|
||||
}
|
||||
|
||||
diff --git a/t/op/svleak.t b/t/op/svleak.t
|
||||
index 2f09af3..011c184 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 => 23;
|
||||
+plan tests => 24;
|
||||
|
||||
# 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
|
||||
@@ -176,3 +176,23 @@ leak(2, 0, sub {
|
||||
each %$h;
|
||||
undef $h;
|
||||
}, 'tied hash iteration does not leak');
|
||||
+
|
||||
+# [perl #107000]
|
||||
+package hhtie {
|
||||
+ sub TIEHASH { bless [] }
|
||||
+ sub STORE { $_[0][0]{$_[1]} = $_[2] }
|
||||
+ sub FETCH { die if $explosive; $_[0][0]{$_[1]} }
|
||||
+ sub FIRSTKEY { keys %{$_[0][0]}; each %{$_[0][0]} }
|
||||
+ sub NEXTKEY { each %{$_[0][0]} }
|
||||
+}
|
||||
+leak(2,!!$Config{mad}, sub {
|
||||
+ eval q`
|
||||
+ BEGIN {
|
||||
+ $hhtie::explosive = 0;
|
||||
+ tie %^H, hhtie;
|
||||
+ $^H{foo} = bar;
|
||||
+ $hhtie::explosive = 1;
|
||||
+ }
|
||||
+ { 1; }
|
||||
+ `;
|
||||
+}, 'hint-hash copying does not leak');
|
||||
--
|
||||
1.8.1.4
|
||||
|
@ -1,78 +0,0 @@
|
||||
From 316518b545904d368d703005f1622fde03349567 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Fri, 21 Sep 2012 22:01:19 -0700
|
||||
Subject: [PATCH] Free iterator when freeing tied hash
|
||||
|
||||
The current iterator was leaking when a tied hash was freed or
|
||||
undefined.
|
||||
|
||||
Since we already have a mechanism, namely HvLAZYDEL, for freeing
|
||||
HvEITER when not referenced elsewhere, we can use that.
|
||||
|
||||
Petr Pisar: Ported to 5.16.3.
|
||||
---
|
||||
hv.c | 3 +++
|
||||
t/op/svleak.t | 15 ++++++++++++++-
|
||||
2 files changed, 17 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/hv.c b/hv.c
|
||||
index a031703..3c35341 100644
|
||||
--- a/hv.c
|
||||
+++ b/hv.c
|
||||
@@ -2346,6 +2346,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
|
||||
if (entry) {
|
||||
sv_setsv(key, HeSVKEY_force(entry));
|
||||
SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
|
||||
+ HeSVKEY_set(entry, NULL);
|
||||
}
|
||||
else {
|
||||
char *k;
|
||||
@@ -2353,6 +2354,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
|
||||
|
||||
/* one HE per MAGICAL hash */
|
||||
iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
|
||||
+ HvLAZYDEL_on(hv); /* make sure entry gets freed */
|
||||
Zero(entry, 1, HE);
|
||||
Newxz(k, HEK_BASESIZE + sizeof(const SV *), char);
|
||||
hek = (HEK*)k;
|
||||
@@ -2369,6 +2371,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
|
||||
Safefree(HeKEY_hek(entry));
|
||||
del_HE(entry);
|
||||
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
|
||||
+ HvLAZYDEL_off(hv);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
diff --git a/t/op/svleak.t b/t/op/svleak.t
|
||||
index 6cfee2e..2f09af3 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 => 22;
|
||||
+plan tests => 23;
|
||||
|
||||
# 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
|
||||
@@ -163,3 +163,16 @@ leak(2,0,sub { !$^V }, '[perl #109762] version object in boolean context');
|
||||
|
||||
# [perl #114764] Attributes leak scalars
|
||||
leak(2, 0, sub { eval 'my $x : shared' }, 'my $x :shared used to leak');
|
||||
+
|
||||
+# Tied hash iteration was leaking if the hash was freed before itera-
|
||||
+# tion was over.
|
||||
+package t {
|
||||
+ sub TIEHASH { bless [] }
|
||||
+ sub FIRSTKEY { 0 }
|
||||
+}
|
||||
+leak(2, 0, sub {
|
||||
+ my $h = {};
|
||||
+ tie %$h, t;
|
||||
+ each %$h;
|
||||
+ undef $h;
|
||||
+}, 'tied hash iteration does not leak');
|
||||
--
|
||||
1.8.1.4
|
||||
|
@ -1,148 +0,0 @@
|
||||
From 13716dc35cd0869b98bd30cebbdeb8d48ab07a8b Mon Sep 17 00:00:00 2001
|
||||
From: Nicholas Clark <nick@ccl4.org>
|
||||
Date: Sat, 14 Apr 2012 15:51:33 +0200
|
||||
Subject: [PATCH] Remove PERL_ASYNC_CHECK() from Perl_leave_scope().
|
||||
|
||||
PERL_ASYNC_CHECK() was added to Perl_leave_scope() as part of commit
|
||||
f410a2119920dd04, which moved signal dispatch from the runloop to
|
||||
control flow ops, to mitigate nearly all of the speed cost of safe
|
||||
signals.
|
||||
|
||||
The assumption was that scope exit was a safe place to dispatch signals.
|
||||
However, this is not true, as parts of the regex engine call
|
||||
leave_scope(), the regex engine stores some state in per-interpreter
|
||||
variables, and code called within signal handlers can change these
|
||||
values.
|
||||
|
||||
Hence remove the call to PERL_ASYNC_CHECK() from Perl_leave_scope(), and
|
||||
add it explicitly in the various OPs which were relying on their call to
|
||||
leave_scope() to dispatch any pending signals. Also add a
|
||||
PERL_ASYNC_CHECK() to the exit of the runloop, which ensures signals
|
||||
still dispatch from S_sortcv() and S_sortcv_stacked(), as well as
|
||||
addressing one of the concerns in the commit message of
|
||||
f410a2119920dd04:
|
||||
|
||||
Subtle bugs might remain - there might be constructions that enter
|
||||
the runloop (where signals used to be dispatched) but don't contain
|
||||
any PERL_ASYNC_CHECK() calls themselves.
|
||||
|
||||
Finally, move the PERL_ASYNC_CHECK(); added by that commit to pp_goto to
|
||||
the end of the function, to be consistent with the positioning of all
|
||||
other PERL_ASYNC_CHECK() calls - at the beginning or end of OP
|
||||
functions, hence just before the return to or just after the call from
|
||||
the runloop, and hence effectively at the same point as the previous
|
||||
location of PERL_ASYNC_CHECK() in the runloop.
|
||||
---
|
||||
dump.c | 1 +
|
||||
pp_ctl.c | 11 ++++++++++-
|
||||
run.c | 1 +
|
||||
scope.c | 2 --
|
||||
4 files changed, 12 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/dump.c b/dump.c
|
||||
index b238ee0..d770a65 100644
|
||||
--- a/dump.c
|
||||
+++ b/dump.c
|
||||
@@ -2118,6 +2118,7 @@ Perl_runops_debug(pTHX)
|
||||
}
|
||||
} while ((PL_op = PL_op->op_ppaddr(aTHX)));
|
||||
DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
|
||||
+ PERL_ASYNC_CHECK();
|
||||
|
||||
TAINT_NOT;
|
||||
return 0;
|
||||
diff --git a/pp_ctl.c b/pp_ctl.c
|
||||
index fd92efa..6206a25 100644
|
||||
--- a/pp_ctl.c
|
||||
+++ b/pp_ctl.c
|
||||
@@ -377,6 +377,7 @@ PP(pp_substcont)
|
||||
TAINT_NOT;
|
||||
LEAVE_SCOPE(cx->sb_oldsave);
|
||||
POPSUBST(cx);
|
||||
+ PERL_ASYNC_CHECK();
|
||||
RETURNOP(pm->op_next);
|
||||
/* NOTREACHED */
|
||||
}
|
||||
@@ -2732,6 +2733,7 @@ PP(pp_next)
|
||||
if (PL_scopestack_ix < inner)
|
||||
leave_scope(PL_scopestack[PL_scopestack_ix]);
|
||||
PL_curcop = cx->blk_oldcop;
|
||||
+ PERL_ASYNC_CHECK();
|
||||
return (cx)->blk_loop.my_op->op_nextop;
|
||||
}
|
||||
|
||||
@@ -2774,6 +2776,7 @@ PP(pp_redo)
|
||||
LEAVE_SCOPE(oldsave);
|
||||
FREETMPS;
|
||||
PL_curcop = cx->blk_oldcop;
|
||||
+ PERL_ASYNC_CHECK();
|
||||
return redo_op;
|
||||
}
|
||||
|
||||
@@ -2978,6 +2981,7 @@ PP(pp_goto)
|
||||
PUTBACK;
|
||||
(void)(*CvXSUB(cv))(aTHX_ cv);
|
||||
LEAVE;
|
||||
+ PERL_ASYNC_CHECK();
|
||||
return retop;
|
||||
}
|
||||
else {
|
||||
@@ -3049,6 +3053,7 @@ PP(pp_goto)
|
||||
}
|
||||
}
|
||||
}
|
||||
+ PERL_ASYNC_CHECK();
|
||||
RETURNOP(CvSTART(cv));
|
||||
}
|
||||
}
|
||||
@@ -3209,6 +3214,7 @@ PP(pp_goto)
|
||||
PL_do_undump = FALSE;
|
||||
}
|
||||
|
||||
+ PERL_ASYNC_CHECK();
|
||||
RETURNOP(retop);
|
||||
}
|
||||
|
||||
@@ -5129,10 +5135,13 @@ PP(pp_leavewhen)
|
||||
leave_scope(PL_scopestack[PL_scopestack_ix]);
|
||||
PL_curcop = cx->blk_oldcop;
|
||||
|
||||
+ PERL_ASYNC_CHECK();
|
||||
return cx->blk_loop.my_op->op_nextop;
|
||||
}
|
||||
- else
|
||||
+ else {
|
||||
+ PERL_ASYNC_CHECK();
|
||||
RETURNOP(cx->blk_givwhen.leave_op);
|
||||
+ }
|
||||
}
|
||||
|
||||
PP(pp_continue)
|
||||
diff --git a/run.c b/run.c
|
||||
index 7c1d0aa..774852d 100644
|
||||
--- a/run.c
|
||||
+++ b/run.c
|
||||
@@ -40,6 +40,7 @@ Perl_runops_standard(pTHX)
|
||||
register OP *op = PL_op;
|
||||
while ((PL_op = op = op->op_ppaddr(aTHX))) {
|
||||
}
|
||||
+ PERL_ASYNC_CHECK();
|
||||
|
||||
TAINT_NOT;
|
||||
return 0;
|
||||
diff --git a/scope.c b/scope.c
|
||||
index ffd0552..121d1f7 100644
|
||||
--- a/scope.c
|
||||
+++ b/scope.c
|
||||
@@ -1168,8 +1168,6 @@ Perl_leave_scope(pTHX_ I32 base)
|
||||
}
|
||||
|
||||
PL_tainted = was;
|
||||
-
|
||||
- PERL_ASYNC_CHECK();
|
||||
}
|
||||
|
||||
void
|
||||
--
|
||||
1.8.1.4
|
||||
|
@ -1,81 +0,0 @@
|
||||
From 1735f6f53ca19f99c6e9e39496c486af323ba6a8 Mon Sep 17 00:00:00 2001
|
||||
From: Brian Carlson <brian.carlson@cpanel.net>
|
||||
Date: Wed, 28 Nov 2012 08:54:33 -0500
|
||||
Subject: [PATCH] Fix misparsing of maketext strings.
|
||||
|
||||
Case 61251: This commit fixes a misparse of maketext strings that could
|
||||
lead to arbitrary code execution. Basically, maketext was compiling
|
||||
bracket notation into functions, but neglected to escape backslashes
|
||||
inside the content or die on fully-qualified method names when
|
||||
generating the code. This change escapes all such backslashes and dies
|
||||
when a method name with a colon or apostrophe is specified.
|
||||
---
|
||||
AUTHORS | 1 +
|
||||
dist/Locale-Maketext/lib/Locale/Maketext.pm | 24 ++++++++----------------
|
||||
2 files changed, 9 insertions(+), 16 deletions(-)
|
||||
|
||||
diff --git a/AUTHORS b/AUTHORS
|
||||
index 70734b0..009dea0 100644
|
||||
--- a/AUTHORS
|
||||
+++ b/AUTHORS
|
||||
@@ -154,6 +154,7 @@ Breno G. de Oliveira <garu@cpan.org>
|
||||
Brent Dax <brentdax@cpan.org>
|
||||
Brooks D Boyd
|
||||
Brian Callaghan <callagh@itginc.com>
|
||||
+Brian Carlson <brian.carlson@cpanel.net>
|
||||
Brian Clarke <clarke@appliedmeta.com>
|
||||
brian d foy <brian.d.foy@gmail.com>
|
||||
Brian Fraser <fraserbn@gmail.com>
|
||||
diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm
|
||||
index 4822027..63e5fba 100644
|
||||
--- a/dist/Locale-Maketext/lib/Locale/Maketext.pm
|
||||
+++ b/dist/Locale-Maketext/lib/Locale/Maketext.pm
|
||||
@@ -625,21 +625,9 @@ sub _compile {
|
||||
# 0-length method name means to just interpolate:
|
||||
push @code, ' (';
|
||||
}
|
||||
- elsif($m =~ /^\w+(?:\:\:\w+)*$/s
|
||||
- and $m !~ m/(?:^|\:)\d/s
|
||||
- # exclude starting a (sub)package or symbol with a digit
|
||||
+ elsif($m =~ /^\w+$/s
|
||||
+ # exclude anything fancy, especially fully-qualified module names
|
||||
) {
|
||||
- # Yes, it even supports the demented (and undocumented?)
|
||||
- # $obj->Foo::bar(...) syntax.
|
||||
- $target->_die_pointing(
|
||||
- $string_to_compile, q{Can't use "SUPER::" in a bracket-group method},
|
||||
- 2 + length($c[-1])
|
||||
- )
|
||||
- if $m =~ m/^SUPER::/s;
|
||||
- # Because for SUPER:: to work, we'd have to compile this into
|
||||
- # the right package, and that seems just not worth the bother,
|
||||
- # unless someone convinces me otherwise.
|
||||
-
|
||||
push @code, ' $_[0]->' . $m . '(';
|
||||
}
|
||||
else {
|
||||
@@ -693,7 +681,9 @@ sub _compile {
|
||||
elsif(substr($1,0,1) ne '~') {
|
||||
# it's stuff not containing "~" or "[" or "]"
|
||||
# i.e., a literal blob
|
||||
- $c[-1] .= $1;
|
||||
+ my $text = $1;
|
||||
+ $text =~ s/\\/\\\\/g;
|
||||
+ $c[-1] .= $text;
|
||||
|
||||
}
|
||||
elsif($1 eq '~~') { # "~~"
|
||||
@@ -731,7 +721,9 @@ sub _compile {
|
||||
else {
|
||||
# It's a "~X" where X is not a special character.
|
||||
# Consider it a literal ~ and X.
|
||||
- $c[-1] .= $1;
|
||||
+ my $text = $1;
|
||||
+ $text =~ s/\\/\\\\/g;
|
||||
+ $c[-1] .= $text;
|
||||
}
|
||||
}
|
||||
}
|
||||
--
|
||||
1.7.11.7
|
||||
|
@ -1,48 +0,0 @@
|
||||
From 4da80956418bbe1fdc23cad0b1cbb24cd7b87609 Mon Sep 17 00:00:00 2001
|
||||
From: =?UTF-8?q?Patrik=20H=C3=A4gglund?= <patrik.h.hagglund@ericsson.com>
|
||||
Date: Sat, 2 Feb 2013 20:21:05 +0100
|
||||
Subject: [PATCH] PATCH [perl #106212] Add PL_perlio_mutex to
|
||||
atfork_lock/unlock
|
||||
|
||||
Using threads + fork() on Linux, and IO operations in the threads, the
|
||||
PL_perlio_mutex may be left in a locked state at the call of fork(),
|
||||
potentially leading to deadlock in the child process at subsequent IO
|
||||
operations. (Threads are pre-empted and not continued in the child
|
||||
process after the fork.)
|
||||
|
||||
Therefore, ensure that the PL_perlio_mutex is unlocked in the child
|
||||
process, right after fork(), by using atfork_lock/unlock.
|
||||
|
||||
(The RT text gives ways to reproduce the problem, but are not easily
|
||||
added to Perl's test suite)
|
||||
---
|
||||
util.c | 6 ++++++
|
||||
1 file changed, 6 insertions(+)
|
||||
|
||||
diff --git a/util.c b/util.c
|
||||
index 5c695b8..75381f1 100644
|
||||
--- a/util.c
|
||||
+++ b/util.c
|
||||
@@ -2798,6 +2798,9 @@ Perl_atfork_lock(void)
|
||||
dVAR;
|
||||
#if defined(USE_ITHREADS)
|
||||
/* locks must be held in locking order (if any) */
|
||||
+# ifdef USE_PERLIO
|
||||
+ MUTEX_LOCK(&PL_perlio_mutex);
|
||||
+# endif
|
||||
# ifdef MYMALLOC
|
||||
MUTEX_LOCK(&PL_malloc_mutex);
|
||||
# endif
|
||||
@@ -2812,6 +2815,9 @@ Perl_atfork_unlock(void)
|
||||
dVAR;
|
||||
#if defined(USE_ITHREADS)
|
||||
/* locks must be released in same order as in atfork_lock() */
|
||||
+# ifdef USE_PERLIO
|
||||
+ MUTEX_UNLOCK(&PL_perlio_mutex);
|
||||
+# endif
|
||||
# ifdef MYMALLOC
|
||||
MUTEX_UNLOCK(&PL_malloc_mutex);
|
||||
# endif
|
||||
--
|
||||
1.8.1.4
|
||||
|
Loading…
Reference in New Issue
Block a user