Don't forget to whine about \d__\d.

p4raw-id: //depot/perl@10038

2 files changed, 18 insertions, 11 deletions

diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke
index f60c9480b9..6adddfc800 100644
--- a/t/pragma/warn/toke
+++ b/t/pragma/warn/toke
@@ -405,6 +405,9 @@ $a = 123.456E_-12; print "$a\n";	# 36
 $a = 123.456E-_12; print "$a\n";	# 37
 $a = 123.456E-1_2; print "$a\n";
 $a = 123.456E-12_; print "$a\n";	# 39
+$a = 1__23; print "$a\n";		# 40
+$a = 12.3__4; print "$a\n";		# 41
+$a = 12.34e1__2; print "$a\n";		# 42
 no warnings 'syntax' ;
 $a = _123; print "$a\n";
 $a = 1_23; print "$a\n";
@@ -443,6 +446,9 @@ $a = 123.456E_-12; print "$a\n";
 $a = 123.456E-_12; print "$a\n";
 $a = 123.456E-1_2; print "$a\n";
 $a = 123.456E-12_; print "$a\n";
+$a = 1__23; print "$a\n";
+$a = 12.3__4; print "$a\n";
+$a = 12.34e1__2; print "$a\n";
 EXPECT
 Misplaced _ in number at - line 6.
 Misplaced _ in number at - line 11.
@@ -461,6 +467,9 @@ Misplaced _ in number at - line 35.
 Misplaced _ in number at - line 36.
 Misplaced _ in number at - line 37.
 Misplaced _ in number at - line 39.
+Misplaced _ in number at - line 40.
+Misplaced _ in number at - line 41.
+Misplaced _ in number at - line 42.
 _123
 123
 123
@@ -498,6 +507,9 @@ _123
 1.23456e-10
 1.23456e-10
 1.23456e-10
+123
+12.34
+12340000000000
 _123
 123
 123
@@ -535,6 +547,9 @@ _123
 1.23456e-10
 1.23456e-10
 1.23456e-10
+123
+12.34
+12340000000000
 ########
 # toke.c
 use warnings 'bareword' ;
diff --git a/toke.c b/toke.c
index 214e43912b..fe4069af3c 100644
--- a/toke.c
+++ b/toke.c
@@ -7189,29 +7189,21 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 	        lastub = s++;
 	    }
 
-	    /* read off the first digit */
-	    if (isDIGIT(*s)) {
-		if (d >= e)
-		    Perl_croak(aTHX_ number_too_long);
-		*d++ = *s++;
-	    }
-
 	    /* read digits of exponent */
 	    while (isDIGIT(*s) || *s == '_') {
 	        if (isDIGIT(*s)) {
 		    if (d >= e)
 		        Perl_croak(aTHX_ number_too_long);
-		    *d++ = *s;
+		    *d++ = *s++;
 		}
 		else {
 		   if (ckWARN(WARN_SYNTAX) &&
 		       ((lastub && s == lastub + 1) ||
-			!isDIGIT(s[1])))
+			(!isDIGIT(s[1]) && s[1] != '_')))
 		       Perl_warner(aTHX_ WARN_SYNTAX,
 				   "Misplaced _ in number");
-		   lastub = s;
+		   lastub = s++;
 		}
-		s++;
 	    }
 	}