toke.c - handle ${10} properly - Issue #12948

${10} and $10 were handled differently, this patch makes them be handled
the same. It also forbids multi-digit numeric variables from starting
with 0. Thus $00 is now a new fatal exception

    "Numeric variables with more than one digit may not start with '0'"

pod/perldiag.pod

@@ -4396,6 +4396,13 @@ the braces.
 or printf() would have been too large for the underlying C function to
 report.  This limit is typically 2GB.
 
+=item Numeric variables with more than one digit may not start with '0'
+
+(F) The only numeric variable which is allowed to start with a 0 is C<$0>,
+and you mentioned a variable that starts with 0 that has more than one
+digit. You probably want to remove the leading 0, or if the intent was
+to express a variable name in octal you should convert to decimal.
+
 =item Octal number > 037777777777 non-portable
 
 (W portable) The octal number you specified is larger than 2**32-1

t/comp/parser_run.t

@@ -10,12 +10,12 @@ BEGIN {
     set_up_inc( qw(. ../lib ) );
 }
 
-plan(5);
+plan(6);
 
 # [perl #130814] can reallocate lineptr while looking ahead for
 # "Missing $ on loop variable" diagnostic.
 my $result = fresh_perl(
-    " foreach m0\n\$" . ("0" x 0x2000),
+    " foreach m0\n\$" . ("v" x 0x2000),
     { stderr => 1 },
 );
 is($result . "\n", <<EXPECT);
@@ -24,6 +24,12 @@ syntax error at - line 3, near "foreach m0
 Identifier too long at - line 3.
 EXPECT
 
+fresh_perl_is(<<'EOS', <<'EXPECT', {}, "check zero vars");
+print $001;
+EOS
+Numeric variables with more than one digit may not start with '0' at - line 1.
+EXPECT
+
 fresh_perl_is(<<EOS, <<'EXPECT', {}, "linestart before bufptr");
 \${ \xB6eeeeeeeeeeee
 'x

toke.c

@@ -94,6 +94,7 @@ Individual members of C<PL_parser> have their own documentation.
     && ((XPVIV*)SvANY(sv))->xiv_u.xivu_eval_seen)
 
 static const char* const ident_too_long = "Identifier too long";
+static const char* const ident_var_zero_multi_digit = "Numeric variables with more than one digit may not start with '0'";
 
 #  define NEXTVAL_NEXTTOKE PL_nextval[PL_nexttoke]
 
@@ -9848,12 +9849,17 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
 
     if (isSPACE(*s) || !*s)
 	s = skipspace(s);
-    if (isDIGIT(*s)) {
-	while (isDIGIT(*s)) {
-	    if (d >= e)
-		Perl_croak(aTHX_ "%s", ident_too_long);
-	    *d++ = *s++;
-	}
+    if (isDIGIT(*s)) { /* handle $0 and $1 $2 and $10 and etc */
+        bool is_zero= *s == '0' ? TRUE : FALSE;
+        char *digit_start= d;
+        *d++ = *s++;
+        while (s < PL_bufend && isDIGIT(*s)) {
+            if (d >= e)
+                Perl_croak(aTHX_ "%s", ident_too_long);
+            *d++ = *s++;
+        } 
+        if (is_zero && d - digit_start > 1)
+            Perl_croak(aTHX_ ident_var_zero_multi_digit);
     }
     else {  /* See if it is a "normal" identifier */
         parse_ident(&s, &d, e, 1, is_utf8, FALSE, TRUE);
@@ -9905,6 +9911,19 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
         }
         else {
             *d = *s++;
+            /* special case to handle ${10}, ${11} the same way we handle ${1} etc */
+            if (isDIGIT(*d)) {
+                bool is_zero= *d == '0' ? TRUE : FALSE;
+                char *digit_start= d;
+                while (s < PL_bufend && isDIGIT(*s)) {
+                    d++;
+                    if (d >= e)
+                        Perl_croak(aTHX_ "%s", ident_too_long);
+                    *d= *s++;
+                }
+                if (is_zero && d - digit_start > 1)
+                    Perl_croak(aTHX_ ident_var_zero_multi_digit);
+            }
             d[1] = '\0';
         }
     }