In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4f08ed80a1ad3deb06ce5d8d20cc2d176dcbced0?hp=b2ac59d1d0fda74d6612701d8316fe8dfb6a1b90>
- Log ----------------------------------------------------------------- commit 4f08ed80a1ad3deb06ce5d8d20cc2d176dcbced0 Author: Yves Orton <[email protected]> Date: Thu Jun 29 11:31:14 2017 +0200 Parse caret vars with subscripts the same as normal vars inside of ${..} escaping 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. ----------------------------------------------------------------------- Summary of changes: 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 e154aca801..89d46dfce0 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 0dcf623194..ace92e3989 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 [email protected] */ - 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); -- Perl5 Master Repository
