From a501e07f4ef4c5b32d3487ed50d9fe6bdcc5929a Mon Sep 17 00:00:00 2001
From: Petr Písař <ppi...@redhat.com>
Date: Aug 08 2017 13:57:20 +0000
Subject: Parse caret variables with subscripts as normal variables inside
${...} escaping
---
diff --git
a/perl-5.27.1-Parse-caret-vars-with-subscripts-the-same-as-normal-.patch
b/perl-5.27.1-Parse-caret-vars-with-subscripts-the-same-as-normal-.patch
new file mode 100644
index 0000000..a8398c3
--- /dev/null
+++ b/perl-5.27.1-Parse-caret-vars-with-subscripts-the-same-as-normal-.patch
@@ -0,0 +1,141 @@
+From 4f08ed80a1ad3deb06ce5d8d20cc2d176dcbced0 Mon Sep 17 00:00:00 2001
+From: Yves Orton <demer...@gmail.com>
+Date: Thu, 29 Jun 2017 11:31:14 +0200
+Subject: [PATCH] Parse caret vars with subscripts the same as normal vars
+ inside of ${..} escaping
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+This behavior is discussed in perl #131664, which complains that
+"${^CAPTURE}[0]" does not work as expected. Abigail explains the
+behavior is by design and Eirik Berg Hanssen expands on that explanation
+pointing out that what /should/ work, "${^CAPTURE[0]}" does not,
+which Sawyer then ruled was a bug.
+
+So this patch makes "${^CAPTURE[0]}" (and "${^CAPTURE [0]}" [hi
+abigial]) work the same as they would if the var was called @foo.
+
+Signed-off-by: Petr Písař <ppi...@redhat.com>
+---
+ t/base/lex.t | 28 +++++++++++++++++++++++++++-
+ toke.c | 46 +++++++++++++++++++++++++---------------------
+ 2 files changed, 52 insertions(+), 22 deletions(-)
+
+diff --git a/t/base/lex.t b/t/base/lex.t
+index e154aca..89d46df 100644
+--- a/t/base/lex.t
++++ b/t/base/lex.t
+@@ -1,6 +1,6 @@
+ #!./perl
+
+-print "1..109\n";
++print "1..116\n";
+
+ $x = 'x';
+
+@@ -154,6 +154,32 @@ my $test = 31;
+ print "not " unless index ($@, 'Can\'t use global $^XYZ in "my"') > -1;
+ print "ok $test\n"; $test++;
+ # print "($@)\n" if $@;
++#
++ ${^TEST}= "splat";
++ @{^TEST}= ("foo", "bar");
++ %{^TEST}= ("foo" => "FOO", "bar" => "BAR" );
++
++ print "not " if "${^TEST}" ne "splat";
++ print "ok $test\n"; $test++;
++
++ print "not " if "${^TEST}[0]" ne "splat[0]";
++ print "ok $test\n"; $test++;
++
++ print "not " if "${^TEST[0]}" ne "foo";
++ print "ok $test\n"; $test++;
++
++ print "not " if "${ ^TEST [1] }" ne "bar";
++ print "ok $test\n"; $test++;
++
++ print "not " if "${^TEST}{foo}" ne "splat{foo}";
++ print "ok $test\n"; $test++;
++
++ print "not " if "${^TEST{foo}}" ne "FOO";
++ print "ok $test\n"; $test++;
++
++ print "not " if "${ ^TEST {bar} }" ne "BAR";
++ print "ok $test\n"; $test++;
++
+
+ # Now let's make sure that caret variables are all forced into the main
package.
+ package Someother;
+diff --git a/toke.c b/toke.c
+index 0dcf623..ace92e3 100644
+--- a/toke.c
++++ b/toke.c
+@@ -9352,19 +9352,36 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN
destlen, I32 ck_uni)
+ bool skip;
+ char *s2;
+ /* If we were processing {...} notation then... */
+- if (isIDFIRST_lazy_if_safe(d, e, is_utf8)) {
+- /* if it starts as a valid identifier, assume that it is one.
+- (the later check for } being at the expected point will trap
+- cases where this doesn't pan out.) */
+- d += is_utf8 ? UTF8SKIP(d) : 1;
+- parse_ident(&s, &d, e, 1, is_utf8, TRUE);
+- *d = '\0';
++ if (isIDFIRST_lazy_if_safe(d, e, is_utf8)
++ || (!isPRINT(*d) /* isCNTRL(d), plus all non-ASCII */
++ && isWORDCHAR(*s))
++ ) {
++ /* note we have to check for a normal identifier first,
++ * as it handles utf8 symbols, and only after that has
++ * been ruled out can we look at the caret words */
++ if (isIDFIRST_lazy_if_safe(d, e, is_utf8) ) {
++ /* if it starts as a valid identifier, assume that it is one.
++ (the later check for } being at the expected point will
trap
++ cases where this doesn't pan out.) */
++ d += is_utf8 ? UTF8SKIP(d) : 1;
++ parse_ident(&s, &d, e, 1, is_utf8, TRUE);
++ *d = '\0';
++ }
++ else { /* caret word: ${^Foo} ${^CAPTURE[0]} */
++ d++;
++ while (isWORDCHAR(*s) && d < e) {
++ *d++ = *s++;
++ }
++ if (d >= e)
++ Perl_croak(aTHX_ "%s", ident_too_long);
++ *d = '\0';
++ }
+ tmp_copline = CopLINE(PL_curcop);
+ if (s < PL_bufend && isSPACE(*s)) {
+ s = skipspace(s);
+ }
+ if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
+- /* ${foo[0]} and ${foo{bar}} notation. */
++ /* ${foo[0]} and ${foo{bar}} and ${^CAPTURE[0]} notation. */
+ if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest, 0)) {
+ const char * const brack =
+ (const char *)
+@@ -9383,19 +9400,6 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen,
I32 ck_uni)
+ return s;
+ }
+ }
+- /* Handle extended ${^Foo} variables
+- * 1999-02-27 mjd-perl-pa...@plover.com */
+- else if (! isPRINT(*d) /* isCNTRL(d), plus all non-ASCII */
+- && isWORDCHAR(*s))
+- {
+- d++;
+- while (isWORDCHAR(*s) && d < e) {
+- *d++ = *s++;
+- }
+- if (d >= e)
+- Perl_croak(aTHX_ "%s", ident_too_long);
+- *d = '\0';
+- }
+
+ if ( !tmp_copline )
+ tmp_copline = CopLINE(PL_curcop);
+--
+2.9.4
+
diff --git
a/perl-5.27.1-add-an-additional-test-for-whitespace-tolerance-in-c.patch
b/perl-5.27.1-add-an-additional-test-for-whitespace-tolerance-in-c.patch
new file mode 100644
index 0000000..2df1317
--- /dev/null
+++ b/perl-5.27.1-add-an-additional-test-for-whitespace-tolerance-in-c.patch
@@ -0,0 +1,43 @@
+From 9b7d3fdf8458e3581b4fb3a6c557b4db4e1f31e8 Mon Sep 17 00:00:00 2001
+From: Yves Orton <demer...@gmail.com>
+Date: Thu, 29 Jun 2017 13:20:49 +0200
+Subject: [PATCH] add an additional test for whitespace tolerance in caret
+ word-vars
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Signed-off-by: Petr Písař <ppi...@redhat.com>
+---
+ t/base/lex.t | 7 +++++--
+ 1 file changed, 5 insertions(+), 2 deletions(-)
+
+diff --git a/t/base/lex.t b/t/base/lex.t
+index 89d46df..de33e7a 100644
+--- a/t/base/lex.t
++++ b/t/base/lex.t
+@@ -1,6 +1,6 @@
+ #!./perl
+
+-print "1..116\n";
++print "1..117\n";
+
+ $x = 'x';
+
+@@ -158,9 +158,12 @@ my $test = 31;
+ ${^TEST}= "splat";
+ @{^TEST}= ("foo", "bar");
+ %{^TEST}= ("foo" => "FOO", "bar" => "BAR" );
+-
++
+ print "not " if "${^TEST}" ne "splat";
+ print "ok $test\n"; $test++;
++
++ print "not " if "${ ^TEST }" ne "splat";
++ print "ok $test\n"; $test++;
+
+ print "not " if "${^TEST}[0]" ne "splat[0]";
+ print "ok $test\n"; $test++;
+--
+2.9.4
+
diff --git a/perl.spec b/perl.spec
index e2bb087..3e705e4 100644
--- a/perl.spec
+++ b/perl.spec
@@ -188,6 +188,11 @@ Patch45:
perl-5.27.1-File-Glob-tweak-rt131211.t-to-be-less-sensitive-on-w
# Fix t/op/hash.t test random failures, in upstream after 5.27.1
Patch46: perl-5.26.0-t-op-hash.t-fixup-intermittently-failing-test.patch
+# Parse caret variables with subscripts as normal variables inside ${...}
+# escaping, RT#131664, in upstream after 5.27.1
+Patch47:
perl-5.27.1-Parse-caret-vars-with-subscripts-the-same-as-normal-.patch
+Patch48:
perl-5.27.1-add-an-additional-test-for-whitespace-tolerance-in-c.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
@@ -2762,6 +2767,8 @@ Perl extension for Version Objects
%patch44 -p1
%patch45 -p1
%patch46 -p1
+%patch47 -p1
+%patch48 -p1
%patch200 -p1
%patch201 -p1
@@ -2794,6 +2801,7 @@ perl -x patchlevel.h \
'Fedora Patch42: Fix reporting malformed UTF-8 character (RT#131646)' \
'Fedora Patch45: Fix File::Glob rt131211.t test random failures' \
'Fedora Patch46: Fix t/op/hash.t test random failures' \
+ 'Fedora Patch47: Parse caret variables with subscripts as normal variables
inside ${...} escaping (RT#131664)' \
'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}
@@ -5081,6 +5089,8 @@ popd
- Fix reporting malformed UTF-8 character (RT#131646)
- Fix File::Glob rt131211.t test random failures
- Fix t/op/hash.t test random failures
+- Parse caret variables with subscripts as normal variables inside ${...}
+ escaping (RT#131664)
* Sat Jul 29 2017 Igor Gnatenko <ignatenkobr...@fedoraproject.org> -
4:5.26.0-397
- Enable separate debuginfo back
https://src.fedoraproject.org/rpms/perl/c/a501e07f4ef4c5b32d3487ed50d9fe6bdcc5929a?branch=master
_______________________________________________
perl-devel mailing list -- perl-devel@lists.fedoraproject.org
To unsubscribe send an email to perl-devel-le...@lists.fedoraproject.org
