From @cpansprout

From b00321c Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 26 Jun 2016 21:45:22 -0700
Subject: [PATCH] [perl #128478] Restore former "$foo::$bar" parsing
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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.

Inline Patch

diff --git a/embed.fnc b/embed.fnc
index cd4b0ff..fe5eb68 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -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
diff --git a/embed.h b/embed.h
index 84f647e..de5a590 100644
--- a/embed.h
+++ b/embed.h
@@ -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)
diff --git a/proto.h b/proto.h
index 42d78cb..9bdbac7 100644
--- a/proto.h
+++ b/proto.h
@@ -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);
diff --git a/t/base/lex.t b/t/base/lex.t
index fe46f14..4ac2b5b 100644
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -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 ++;
diff --git a/toke.c b/toke.c
index 327d984..aebeebb 100644
--- a/toke.c
+++ b/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;

Change in behaviour of "$foo::$bar" in 5.18 #15408

Description

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions