Skip to content
Permalink
Browse files

[perl #128478] Restore former "$foo::$bar" parsing

The function scan_word, in toke.c, is used to parse barewords.  The
scan_ident function is used to scan an identifier after a sigil.

Prior to v5.17.9-108-g07f7264, both functions had their own parsing
loops, and scan_ident actually had two, one for $foo and another
for ${foo}.

The state purpose of 07f7264 was to fix discrepancies in the parsing
of $foo vs ${foo}, by making the two forms use the same parsing code.
In accomplishing this, the commit in question merged not only the
two loops in scan_ident, but all three loops, including the one in
scan_word, by introducing a new function, parse_ident, that the
others call.

One result was that some logic appropriate only to scan_word started
to be applied also to scan_ident; namely, that ::$ would be explicitly
checked for and disallowed (the parsing would stop before the ::), for
the sake of the “Bad name after Foo::” error.

The consequence was that "$foo::$bar" started to be parsed as
$foo."::".$bar, instead of $foo:: . $bar, as previously.

Now, "$foo::@bar" was unaffected, so by fixing one form of inconsis-
tency we ended up form, including B::Deparse bugs (because B::Deparse
was not consistent with the core).

This commit restores the previous behaviour by giving parse_ident an
extra parameter, making the ::$ check optional.
  • Loading branch information
Father Chrysostomos
Father Chrysostomos committed Jun 27, 2016
1 parent f9296ff commit d9d2b74cf46ffb7cc5b88cb749f8cb8dee21425e
Showing with 19 additions and 10 deletions.
  1. +1 −1 embed.fnc
  2. +1 −1 embed.h
  3. +1 −1 proto.h
  4. +8 −1 t/base/lex.t
  5. +8 −6 toke.c
@@ -2548,7 +2548,7 @@ s |int |deprecate_commaless_var_list
s |int |ao |int toketype
s |void|parse_ident|NN char **s|NN char **d \
|NN char * const e|int allow_package \
|bool is_utf8
|bool is_utf8|bool check_dollar
# if defined(PERL_CR_FILTER)
s |I32 |cr_textfilter |int idx|NULLOK SV *sv|int maxlen
s |void |strip_return |NN SV *sv
@@ -1784,7 +1784,7 @@
#define lop(a,b,c) S_lop(aTHX_ a,b,c)
#define missingterm(a) S_missingterm(aTHX_ a)
#define no_op(a,b) S_no_op(aTHX_ a,b)
#define parse_ident(a,b,c,d,e) S_parse_ident(aTHX_ a,b,c,d,e)
#define parse_ident(a,b,c,d,e,f) S_parse_ident(aTHX_ a,b,c,d,e,f)
#define pending_ident() S_pending_ident(aTHX)
#define scan_const(a) S_scan_const(aTHX_ a)
#define scan_formline(a) S_scan_formline(aTHX_ a)
@@ -5496,7 +5496,7 @@ STATIC SV* S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRL
STATIC void S_no_op(pTHX_ const char *const what, char *s);
#define PERL_ARGS_ASSERT_NO_OP \
assert(what)
STATIC void S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8);
STATIC void S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8, bool check_dollar);
#define PERL_ARGS_ASSERT_PARSE_IDENT \
assert(s); assert(d); assert(e)
STATIC int S_pending_ident(pTHX);
@@ -1,6 +1,6 @@
#!./perl

print "1..105\n";
print "1..107\n";

$x = 'x';

@@ -528,3 +528,10 @@ eval q|s##[}#e|;
eval ('/@0{0*->@*/*]');
print "ok $test - 128171\n"; $test++;
}
$foo = "WRONG"; $foo:: = "bar"; $bar = "baz";
print "not " unless "$foo::$bar" eq "barbaz";
print qq|ok $test - [perl #128478] "\$foo::\$bar"\n|; $test++;
@bar = ("baz","bonk");
print "not " unless "$foo::@bar" eq "barbaz bonk";
print qq|ok $test - [perl #128478] "\$foo::\@bar"\n|; $test ++;
14 toke.c
@@ -8819,7 +8819,8 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
}

PERL_STATIC_INLINE void
S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8) {
S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package,
bool is_utf8, bool check_dollar) {
PERL_ARGS_ASSERT_PARSE_IDENT;

for (;;) {
@@ -8855,7 +8856,7 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool
* the code path that triggers the "Bad name after" warning
* when looking for barewords.
*/
&& (*s)[2] != '$') {
&& !(check_dollar && (*s)[2] == '$')) {
*(*d)++ = *(*s)++;
*(*d)++ = *(*s)++;
}
@@ -8877,7 +8878,7 @@ S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN

PERL_ARGS_ASSERT_SCAN_WORD;

parse_ident(&s, &d, e, allow_package, is_utf8);
parse_ident(&s, &d, e, allow_package, is_utf8, TRUE);
*d = '\0';
*slp = d - dest;
return s;
@@ -8925,7 +8926,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
}
}
else { /* See if it is a "normal" identifier */
parse_ident(&s, &d, e, 1, is_utf8);
parse_ident(&s, &d, e, 1, is_utf8, FALSE);
}
*d = '\0';
d = dest;
@@ -8994,7 +8995,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
(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);
parse_ident(&s, &d, e, 1, is_utf8, TRUE);
*d = '\0';
tmp_copline = CopLINE(PL_curcop);
if (s < PL_bufend && isSPACE(*s)) {
@@ -11875,7 +11876,8 @@ S_parse_opt_lexvar(pTHX)
s = PL_bufptr;
d = PL_tokenbuf + 1;
PL_tokenbuf[0] = (char)sigil;
parse_ident(&s, &d, PL_tokenbuf + sizeof(PL_tokenbuf) - 1, 0, cBOOL(UTF));
parse_ident(&s, &d, PL_tokenbuf + sizeof(PL_tokenbuf) - 1, 0,
cBOOL(UTF), FALSE);
PL_bufptr = s;
if (d == PL_tokenbuf+1)
return NULL;

0 comments on commit d9d2b74

Please sign in to comment.
You can’t perform that action at this time.