Remove unnecessary patches

This commit is contained in:
Jitka Plesnikova 2013-07-04 11:25:34 +02:00 committed by Petr Písař
parent 133f2d9408
commit 809d5c55f1
15 changed files with 0 additions and 1180 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 didnt free it for a my variable, because the branch where that
const op was created didnt 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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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