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

Resolves: BZ#978233, BZ#989486, BZ#970567, BZ#988805, BZ#982131

This commit is contained in:
Jitka Plesnikova 2013-09-11 14:05:01 +02:00
parent 26c24d1d6c
commit 5af7c28320
6 changed files with 485 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
perl-5.19.2-Fix-coreamp.t-s-rand-test.patch Normal file
View File

@ -0,0 +1,31 @@
From fba93b250c0d566f7ef26442312286310b2b9b46 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 2 Jun 2013 00:36:33 -0700
Subject: [PATCH] =?UTF-8?q?[perl=20#118237]=20Fix=20coreamp.t=E2=80=99s=20?=
=?UTF-8?q?rand=20test?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
when rand returns something really small that does not
begin with 0, such as 2.90736361456823e-05.
---
t/op/coreamp.t | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index c1f7181..fe7c741 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -637,7 +637,7 @@ test_proto 'quotemeta', '$', '\$';
test_proto 'rand';
$tests += 3;
-like &CORE::rand, qr/^0[.\d+-e]*\z/, '&rand';
+like &CORE::rand, qr/^[.\d+-e]*\z/, '&rand';
unlike join(" ", &CORE::rand), qr/ /, '&rand in list context';
&cmp_ok(&CORE::rand(78), qw '< 78', '&rand with 1 arg');
--
1.8.3.1

96
perl-5.19.2-Fix-crash-with-glob_copy.patch Normal file
View File

@ -0,0 +1,96 @@
From 2f222bbdd2d6da605708c3ab620ac25c62481179 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 28 Jul 2013 12:35:47 -0700
Subject: [PATCH] [perl #119051] Fix crash with \&$glob_copy
$ref = *Foo::nosub;
\&$ref;
The assignment creates a glob copy (coercible glob; one that down-
grades back to a simple scalar when assigned to).
\&$ref autovivifies a stub in that glob. The CvGV pointer ends up
pointing to $ref, rather than *Foo::nosub. $ref can easily cease
being a glob. So crashes happen.
Stub autovivification used to stringify the glob, look it up again by
name, and then vivify the stub in the glob.
In commit 186a5ba82d584 I removed what seemed like a waste of CPU
cycles, but apparently it served some purpose. The lookup caused CvGV
to point to *Foo::nosub, rather than $x.
This commit restores the stringfy-and-lookup if the glob is coercible
(SvFAKE). It goes a little further and turns off the SvFAKE flag if
the glob just looked up is also FAKE.
It turns out this bug is old, and has been triggerable via glob copies
in stash elements for a long time. 186a5ba82d584 made it easier to
trigger the bug (so it is a regression from 5.16).
---
op.c | 8 +++++++-
t/op/gv.t | 16 +++++++++++++++-
2 files changed, 22 insertions(+), 2 deletions(-)
diff --git a/op.c b/op.c
index e308d08..7576509 100644
--- a/op.c
+++ b/op.c
@@ -7918,13 +7918,19 @@ CV *
Perl_newSTUB(pTHX_ GV *gv, bool fake)
{
CV *cv = MUTABLE_CV(newSV_type(SVt_PVCV));
+ GV *cvgv;
PERL_ARGS_ASSERT_NEWSTUB;
assert(!GvCVu(gv));
GvCV_set(gv, cv);
GvCVGEN(gv) = 0;
if (!fake && HvENAME_HEK(GvSTASH(gv)))
gv_method_changed(gv);
- CvGV_set(cv, gv);
+ if (SvFAKE(gv)) {
+ cvgv = gv_fetchsv((SV *)gv, GV_ADDMULTI, SVt_PVCV);
+ SvFAKE_off(cvgv);
+ }
+ else cvgv = gv;
+ CvGV_set(cv, cvgv);
CvFILE_set_from_cop(cv, PL_curcop);
CvSTASH_set(cv, PL_curstash);
GvMULTI_on(gv);
diff --git a/t/op/gv.t b/t/op/gv.t
index deb92f3..806a68a 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
use warnings;
-plan( tests => 245 );
+plan( tests => 247 );
# type coercion on assignment
$foo = 'foo';
@@ -959,6 +959,20 @@ package lrcg {
$::{aoeuaoeuaoeaoeu} = __PACKAGE__; # cow
() = *{"aoeuaoeuaoeaoeu"};
+$x = *_119051;
+$y = \&$x;
+undef $x;
+eval { &$y };
+pass "No crash due to CvGV(vivified stub) pointing to flattened glob copy";
+# Not really supported, but this should not crash either:
+$x = *_119051again;
+delete $::{_119051again};
+$::{_119051again} = $x; # now we have a fake glob under the right name
+$y = \&$x; # so when this tries to look up the right GV for
+undef $::{_119051again}; # CvGV, it still gets a fake one
+eval { $y->() };
+pass "No crash due to CvGV pointing to glob copy in the stash";
+
__END__
Perl
Rules
--
1.8.3.1

184
perl-5.19.2-Fix-rules-for-parsing-numeric-escapes-in-regexes.patch Normal file
View File

@ -0,0 +1,184 @@
From f1e1b256c5c1773d90e828cca6323c53fa23391b Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 25 Jun 2013 21:01:27 +0200
Subject: [PATCH] Fix rules for parsing numeric escapes in regexes
Commit 726ee55d introduced better handling of things like \87 in a
regex, but as an unfortunate side effect broke latex2html.
The rules for handling backslashes in regexen are a bit arcane.
Anything starting with \0 is octal.
The sequences \1 through \9 are always backrefs.
Any other sequence is interpreted as a decimal, and if there
are that many capture buffers defined in the pattern at that point
then the sequence is a backreference. If however it is larger
than the number of buffers the sequence is treated as an octal digit.
A consequence of this is that \118 could be a backreference to
the 118th capture buffer, or it could be the string "\11" . "8". In
other words depending on the context we might even use a different
number of digits for the escape!
This also left an awkward edge case, of multi digit sequences
starting with 8 or 9 like m/\87/ which would result in us parsing
as though we had seen /87/ (iow a null byte at the start) or worse
like /\x{00}87/ which is clearly wrong.
This patches fixes the cases where the capture buffers are defined,
and causes things like the \87 or \97 to throw the same error that
/\8/ would. One might argue we should complain about an illegal
octal sequence, but this seems more consistent with an error like
/\9/ and IMO will be less surprising in an error message.
This patch includes exhaustive tests of patterns of the form
/(a)\1/, /((a))\2/ etc, so that we dont break this again if we
change the logic more.
---
regcomp.c | 31 ++++++++++++++++++++++---------
t/re/pat.t | 19 ++++++++++++++++++-
t/re/re_tests | 7 +++----
t/re/reg_mesg.t | 6 +++---
4 files changed, 46 insertions(+), 17 deletions(-)
diff --git a/regcomp.c b/regcomp.c
index c7f8885..d01f62a 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -10706,7 +10706,7 @@ tryagain:
if (num < 1)
vFAIL("Reference to nonexistent or unclosed group");
}
- if (!isg && num > 9 && num >= RExC_npar)
+ if (!isg && num > 9 && num >= RExC_npar && *RExC_parse != '8' && *RExC_parse != '9')
/* Probably a character specified in octal, e.g. \35 */
goto defchar;
else {
@@ -10983,10 +10983,28 @@ tryagain:
p++;
ender = grok_bslash_c(*p++, UTF, SIZE_ONLY);
break;
- case '0': case '1': case '2': case '3':case '4':
+ case '8': case '9': /* must be a backreference */
+ --p;
+ goto loopdone;
+ case '1': case '2': case '3':case '4':
case '5': case '6': case '7':
- if (*p == '0' ||
- (isDIGIT(p[1]) && atoi(p) >= RExC_npar))
+ /* When we parse backslash escapes there is ambiguity between
+ * backreferences and octal escapes. Any escape from \1 - \9 is
+ * a backreference, any multi-digit escape which does not start with
+ * 0 and which when evaluated as decimal could refer to an already
+ * parsed capture buffer is a backslash. Anything else is octal.
+ *
+ * Note this implies that \118 could be interpreted as 118 OR as
+ * "\11" . "8" depending on whether there were 118 capture buffers
+ * defined already in the pattern.
+ */
+ if ( !isDIGIT(p[1]) || atoi(p) <= RExC_npar )
+ { /* Not to be treated as an octal constant, go
+ find backref */
+ --p;
+ goto loopdone;
+ }
+ case '0':
{
I32 flags = PERL_SCAN_SILENT_ILLDIGIT;
STRLEN numlen = 3;
@@ -11005,11 +11023,6 @@ tryagain:
form_short_octal_warning(p, numlen));
}
}
- else { /* Not to be treated as an octal constant, go
- find backref */
- --p;
- goto loopdone;
- }
if (PL_encoding && ender < 0x100)
goto recode_encoding;
break;
diff --git a/t/re/pat.t b/t/re/pat.t
index bdfea87..99d719d 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -20,7 +20,7 @@ BEGIN {
require './test.pl';
}
-plan tests => 472; # Update this when adding/deleting tests.
+plan tests => 572; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -1363,6 +1363,23 @@ EOP
is ($s, 'XXcdXXX&', 'RT #119125 with /x');
}
+ {
+ # if we have 87 capture buffers defined then \87 should refer to the 87th.
+ # test that this is true for 1..100
+ my $str= "aa";
+ for my $i (1..100) {
+ my $pat= "a";
+ $pat= "($pat)" for 1 .. $i;
+ $pat.="\\$i";
+ eval {
+ ok($str=~/$pat/,"\\$i works with $i buffers");
+ 1;
+ } or do {
+ ok(0,"\\$i works with $i buffers");
+ };
+ }
+ }
+
} # End of sub run_tests
1;
diff --git a/t/re/re_tests b/t/re/re_tests
index b3231c2..9a24360 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -1487,10 +1487,9 @@ abc\N{def - c - \\N{NAME} must be resolved by the lexer
[a\o{1000}] \x{200} y $& \x{200}
# The below were inserting a NULL
-\87 87 y $& 87
-a\87 a87 y $& a87
-a\97 a97 y $& a97
-
+\87 87 c - Reference to nonexistent group in regex
+a\87 a87 c - Reference to nonexistent group in regex
+a\97 a97 c - Reference to nonexistent group in regex
# The below was inserting a NULL into the character class.
[\8\9] \000 Sn - -
diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index b8098fd..56c7b55 100644
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -177,6 +177,9 @@ my @death =
'm/[\o]/' => 'Missing braces on \o{} {#} m/[\o{#}]/',
'm/[\o{}]/' => 'Number with no digits {#} m/[\o{}{#}]/',
'm/(?^-i:foo)/' => 'Sequence (?^-...) not recognized {#} m/(?^-{#}i:foo)/',
+ 'm/\87/' => 'Reference to nonexistent group {#} m/\87{#}/',
+ 'm/a\87/' => 'Reference to nonexistent group {#} m/a\87{#}/',
+ 'm/a\97/' => 'Reference to nonexistent group {#} m/a\97{#}/',
);
# Tests involving a user-defined charnames translator are in pat_advanced.t
@@ -203,9 +206,6 @@ my @warning = (
'/\018/' => '\'\018\' resolved to \'\o{1}8\' {#} m/\018{#}/',
'/[\08]/' => '\'\08\' resolved to \'\o{0}8\' {#} m/[\08{#}]/',
'/[\018]/' => '\'\018\' resolved to \'\o{1}8\' {#} m/[\018{#}]/',
- '/\87/' => 'Unrecognized escape \8 passed through {#} m/\8{#}7/',
- '/a\87/' => 'Unrecognized escape \8 passed through {#} m/a\8{#}7/',
- '/a\97/' => 'Unrecognized escape \9 passed through {#} m/a\9{#}7/',
'/(?=a)*/' => '(?=a)* matches null string many times {#} m/(?=a)*{#}/',
'my $x = \'\m\'; qr/a$x/' => 'Unrecognized escape \m passed through {#} m/a\m{#}/',
'/\q/' => 'Unrecognized escape \q passed through {#} m/\q{#}/',
--
1.8.3.1

68
perl-5.19.2-Fix-using-regexes-with-multiple-code-blocks.patch Normal file
View File

@ -0,0 +1,68 @@
From f5df269c5cef57294662d0b1f80a468b91f13643 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Fri, 5 Jul 2013 23:59:46 -0700
Subject: [PATCH] [perl #117917] /(?{ m|...| }) (?{ $1 })/
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
A regular expression invoked inside a regular expression code block
can cause other code blocks in the same outer regular expression to
see the wrong values in $1.
PL_curpm holds a pointer to the match operator from which $1, $2, etc.
get their values.
Normally PL_curpm is set at the end of a match.
When code blocks are embedded inside a regular expression, PL_curpm
is set during a match to point to PL_reg_curpm, which is a dummy op
pointing to the current regular expression.
S_setup_eval_state is called at the beginning of regexp execution.
It is responsible for setting up PL_regcurpm and making PL_curpm
point to it.
Code blocks are executed using the multicall API. PUSH_MULTICALL
records the value of PL_curpm and POP_MULTICALL makes sure that the
previous value of PL_curpm is restored.
Executing a code block can cause PL_curpm to point to something else.
Since we don’t necessarily do POP_MULTICALL between code block calls
within a single regular expression (sometimes we do, depending on
backtracking), PL_curpm may not have been restored when a second code
block fires. So we have to restore it to point to PL_reg_curpm manu-
ally after calling a code block.
---
regexec.c | 1 +
t/re/re_tests | 2 ++
2 files changed, 3 insertions(+)
diff --git a/regexec.c b/regexec.c
index 12548d5..6367e2e 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4991,6 +4991,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
PL_curcop = ocurcop;
PL_regeol = saved_regeol;
S_regcp_restore(aTHX_ rex, runops_cp, &maxopenparen);
+ PL_curpm = PL_reg_curpm;
if (logical != 2)
break;
diff --git a/t/re/re_tests b/t/re/re_tests
index 9a24360..3921bb7 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -613,6 +613,8 @@ $(?<=^(a)) a y $1 a
^[^bcd]*(c+) aexycd y $1 c
(?{$a=2})a*aa(?{local$a=$a+1})k*c(?{$b=$a}) yaaxxaaaacd y $b 3
(?{$a=2})(a(?{local$a=$a+1}))*aak*c(?{$b=$a}) yaaxxaaaacd y $b 4
+# [perl #117917]
+^(a(?{ "x" =~ m{x}})b)(??{ $1 }) abab y $& abab
(>a+)ab aaab n - -
(?>a+)b aaab y - -
([[:]+) a:[b]: y $1 :[
--
1.8.3.1

69
perl-5.19.3-Reap-child-in-case-where-exception-has-been-thrown.patch Normal file
View File

@ -0,0 +1,69 @@
From cccbbce940ea952c4c236049e98d21a011475cb1 Mon Sep 17 00:00:00 2001
From: Philip Boulain <philip.boulain@smoothwall.net>
Date: Mon, 3 Sep 2012 15:16:26 +0100
Subject: [PATCH] Reap child in case where exception has been thrown
If open3 throws due to an issue such as an exec failure, the caller
cannot know the child PID to wait for. Therefore it is our
responsibility to reap it.
Also update POD, since on some platforms exec failures now ARE raised as
exceptions (since perlbug #72016).
---
ext/IPC-Open3/lib/IPC/Open3.pm | 4 +++-
ext/IPC-Open3/t/IPC-Open3.t | 7 ++++++-
2 files changed, 9 insertions(+), 2 deletions(-)
diff --git a/ext/IPC-Open3/lib/IPC/Open3.pm b/ext/IPC-Open3/lib/IPC/Open3.pm
index 989c2f6..f50146f 100644
--- a/ext/IPC-Open3/lib/IPC/Open3.pm
+++ b/ext/IPC-Open3/lib/IPC/Open3.pm
@@ -57,7 +57,8 @@ as file descriptors.
open3() returns the process ID of the child process. It doesn't return on
failure: it just raises an exception matching C</^open3:/>. However,
C<exec> failures in the child (such as no such file or permission denied),
-are just reported to CHLD_ERR, as it is not possible to trap them.
+are just reported to CHLD_ERR under Windows and OS/2, as it is not possible
+to trap them.
If the child process dies for any reason, the next write to CHLD_IN is
likely to generate a SIGPIPE in the parent, which is fatal by default.
@@ -297,6 +298,7 @@ sub _open3 {
if ($bytes_read) {
(my $bang, $to_read) = unpack('II', $buf);
read($stat_r, my $err = '', $to_read);
+ waitpid $kidpid, 0; # Reap child which should have exited
if ($err) {
utf8::decode $err if $] >= 5.008;
} else {
diff --git a/ext/IPC-Open3/t/IPC-Open3.t b/ext/IPC-Open3/t/IPC-Open3.t
index 7b85b82..6ab519d 100644
--- a/ext/IPC-Open3/t/IPC-Open3.t
+++ b/ext/IPC-Open3/t/IPC-Open3.t
@@ -14,10 +14,11 @@ BEGIN {
}
use strict;
-use Test::More tests => 37;
+use Test::More tests => 38;
use IO::Handle;
use IPC::Open3;
+use POSIX ":sys_wait_h";
my $perl = $^X;
@@ -154,6 +155,10 @@ $TB->current_test($test);
isnt($@, '',
'open3 of a non existent program fails with an exception in the parent')
or do {waitpid $pid, 0};
+ SKIP: {
+ skip 'open3 returned, our responsibility to reap', 1 unless $@;
+ is(waitpid(-1, WNOHANG), -1, 'failed exec child is reaped');
+ }
}
$pid = eval { open3 'WRITE', '', 'ERROR', '/non/existent/program'; };
--
1.8.3.1

38
perl.spec
View File

@ -31,7 +31,7 @@
Name: perl
Version: %{perl_version}
# release number must be even higher, because dual-lived modules will be broken otherwise
Release: 287%{?dist}
Release: 288%{?dist}
Epoch: %{perl_epoch}
Summary: Practical Extraction and Report Language
Group: Development/Languages
@ -99,6 +99,25 @@ Patch15: perl-5.16.3-create_libperl_soname.patch
# Install libperl.so to -Dshrpdir value
Patch16: perl-5.16.3-Install-libperl.so-to-shrpdir-on-Linux.patch
# Fix rules for parsing numeric escapes in regexes, BZ#978233
# Update the upstream patch to work for Perl 5.18.1
Patch17: perl-5.19.2-Fix-rules-for-parsing-numeric-escapes-in-regexes.patch
# Fix crash with \&$glob_copy, rhbz#989486, RT#119051
# Update the upstream patch to work for Perl 5.18.1
Patch18: perl-5.19.2-Fix-crash-with-glob_copy.patch
# Fix coreamp.t's rand test, rhbz#970567, RT#118237
Patch19: perl-5.19.2-Fix-coreamp.t-s-rand-test.patch
# Reap child in case where exception has been thrown, rhbz#988805, RT#114722
Patch20: perl-5.19.3-Reap-child-in-case-where-exception-has-been-thrown.patch
# Fix using regular expressions containing multiple code blocks,
# rhbz#982131, RT#117917
# Update the upstream patch to work for Perl 5.18.1
Patch21: perl-5.19.2-Fix-using-regexes-with-multiple-code-blocks.patch
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
@ -1884,6 +1903,11 @@ tarball from perl.org.
%patch14 -p1
%patch15 -p1
%patch16 -p1
%patch17 -p1
%patch18 -p1
%patch19 -p1
%patch20 -p1
%patch21 -p1
%patch200 -p1
%patch201 -p1
@ -1905,6 +1929,11 @@ perl -x patchlevel.h \
'Fedora Patch14: Do not use system Term::ReadLine::Gnu in tests (RT#118821)' \
'Fedora Patch15: Define SONAME for libperl.so' \
'Fedora Patch16: Install libperl.so to -Dshrpdir value' \
'Fedora Patch17: Fix rules for parsing numeric escapes in regexes' \
'Fedora Patch18: Fix crash with \&$glob_copy (RT#119051)' \
'Fedora Patch19: Fix coreamp.t rand test (RT#118237)' \
'Fedora Patch20: Reap child in case where exception has been thrown (RT#114722)' \
'Fedora Patch21: Fix using regular expressions containing multiple code blocks (RT#117917)' \
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil}
@ -3591,6 +3620,13 @@ sed \
# Old changelog entries are preserved in CVS.
%changelog
* Mon Sep 09 2013 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.18.1-288
- Fix rules for parsing numeric escapes in regexes (bug #978233)
- Fix crash with \&$glob_copy (bug #989486)
- Fix coreamp.t's rand test (bug #970567)
- Reap child in case where exception has been thrown (bug #988805)
- Fix using regexes with multiple code blocks (bug #982131)
* Tue Aug 13 2013 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.18.1-287
- 5.18.1 bump (see <http://search.cpan.org/dist/perl-5.18.1/pod/perldelta.pod>
for release notes)