Parse caret variables with subscripts as normal variables inside ${...} escaping
This commit is contained in:
Petr Písař
parent
fdecf9dd4a
commit
a501e07f4e
@ -0,0 +1,141 @@
|
||||
From 4f08ed80a1ad3deb06ce5d8d20cc2d176dcbced0 Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@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ř <ppisar@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-patch@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
|
||||
|
||||
@ -0,0 +1,43 @@
|
||||
From 9b7d3fdf8458e3581b4fb3a6c557b4db4e1f31e8 Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@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ř <ppisar@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
|
||||
|
||||
10
perl.spec
10
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 <ignatenkobrain@fedoraproject.org> - 4:5.26.0-397
|
||||
- Enable separate debuginfo back
|
||||
|
||||
Loading…
Reference in New Issue
Block a user