toke.c, scan_ident(): use PEEKSPACE() to skip over whitespace.

This fixes a number of bugs regarding whitespace and line numbers
in scan_ident(), such as ${\nfoo\n} not increasing the line number,
or ${\ntime\n[1]} not working.

It goes through a number of hoops to get the correct line number for
warnings emmitted from scan_ident, and reverts CopLINE to its
original value if scan_ident() is giving up and returning from the
point of the opening bracket, like in the case of ${\n\nfoo()}.

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 76f9c33..a16df9c 100644 (file)
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -168,9 +168,9 @@ EXPECT
 Use of literal control characters in variable names is deprecated at (eval 1) line 1.
 Use of literal control characters in variable names is deprecated at (eval 2) line 1.
 Use of literal control characters in variable names is deprecated at (eval 3) line 1.
-Use of literal control characters in variable names is deprecated at (eval 4) line 1.
+Use of literal control characters in variable names is deprecated at (eval 4) line 2.
 Use of literal control characters in variable names is deprecated at (eval 5) line 1.
-Use of literal control characters in variable names is deprecated at (eval 6) line 1.
+Use of literal control characters in variable names is deprecated at (eval 6) line 2.
 ok
 ########
 # toke.c
@@ -402,6 +402,37 @@ EXPECT
 Ambiguous use of ${time{...}} resolved to $time{...} at - line 3.
 ########
 # toke.c
+use warnings 'ambiguous' ;
+$a = ${
+
+    time
+        {2}
+};
+warn "after";
+EXPECT
+Ambiguous use of ${time{...}} resolved to $time{...} at - line 5.
+after at - line 8.
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${
+
+time[2]
+
+};
+$a = ${
+
+time    
+   [2]
+
+};
+warn "after";
+EXPECT
+Ambiguous use of ${time[...]} resolved to $time[...] at - line 5.
+Ambiguous use of ${time[...]} resolved to $time[...] at - line 10.
+after at - line 14.
+########
+# toke.c
 no warnings 'ambiguous' ;
 $a = ${time{2}};
 EXPECT
@@ -432,6 +463,38 @@ Ambiguous use of &{time} resolved to &time at - line 8.
 ########
 # toke.c
 use warnings 'ambiguous' ;
+$a = ${
+time
+} ;
+$a = @{
+time
+} ;
+$a = $#{
+time
+} ;
+$a = %{
+time
+} ;
+$a = *{
+time
+} ;
+$a = defined &{
+time
+
+
+} ;
+warn "last";
+EXPECT
+Ambiguous use of ${time} resolved to $time at - line 4.
+Ambiguous use of @{time} resolved to @time at - line 7.
+Ambiguous use of @{time} resolved to @time at - line 10.
+Ambiguous use of %{time} resolved to %time at - line 13.
+Ambiguous use of *{time} resolved to *time at - line 16.
+Ambiguous use of &{time} resolved to &time at - line 19.
+last at - line 23.
+########
+# toke.c
+use warnings 'ambiguous' ;
 sub fred {}
 $a = ${fred} ;
 no warnings 'ambiguous' ;

diff --git a/t/op/eval.t b/t/op/eval.t
index 2c61a88..e4c2f70 100644 (file)
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan(tests => 129);
+plan(tests => 130);
 
 eval 'pass();';
 
@@ -619,6 +619,18 @@ EOE
        qq'Right line number for eval "$_"';
 }
 
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w .= shift };
+
+    eval "\${\nfoobar\n} = 10; warn q{should be line 3}";
+    is(
+        $w =~ s/eval \d+/eval 1/ra,
+        "should be line 3 at (eval 1) line 3.\n",
+        'eval qq{\${\nfoo\n}; warn} updates the line number correctly'
+    );
+}
+
 sub _117941 { package _117941; eval '$a' }
 delete $::{"_117941::"};
 _117941();

diff --git a/t/op/warn.t b/t/op/warn.t
index 71de5e2..741c2c7 100644 (file)
--- a/t/op/warn.t
+++ b/t/op/warn.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan 30;
+plan 32;
 
 my @warnings;
 my $wa = []; my $ea = [];
@@ -192,4 +192,28 @@ eval "#line 42 Cholmondeley\n \$\@ = 3; warn";
 is @warnings, 2;
 is $warnings[1], $warnings[0], 'warn treats $@=3 and $@="3" the same way';
 
+fresh_perl_is(<<'EOF', "should be line 4 at - line 4.\n", {stderr => 1}, "");
+${
+    foo
+} = "should be line 4";
+warn $foo;
+EOF
+
+TODO: {
+    local $::TODO = "Line numbers don't yet match up for \${ EXPR }";
+    my $expected = <<'EOF';
+line 1 at - line 1.
+line 4 at - line 3.
+also line 4 at - line 4.
+line 5 at - line 5.
+EOF
+    fresh_perl_is(<<'EOF', $expected, {stderr => 1}, "");
+warn "line 1";
+(${
+    foo
+} = "line 5") && warn("line 4"); warn("also line 4");
+warn $foo;
+EOF
+}
+
 1;

diff --git a/toke.c b/toke.c
index 53ad9f8..682fe67 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -9376,6 +9376,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
     char *d = dest;
     char * const e = d + destlen - 3;    /* two-character token, ending NUL */
     bool is_utf8 = cBOOL(UTF);
+    I32 orig_copline, tmp_copline = 0;
 
     PERL_ARGS_ASSERT_SCAN_IDENT;
 
@@ -9416,8 +9417,10 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
     if (*s == '{') {
        bracket = s;
        s++;
-        while (s < PL_bufend && ( SPACE_OR_TAB(*s) || *s == '\n' ))
-          s++;
+       orig_copline = CopLINE(PL_curcop);
+        while (s < PL_bufend && isSPACE(*s)) {
+            s = PEEKSPACE(s);
+        }
     }
 
 /* Is the byte 'd' a legal single character identifier name?  'u' is true
@@ -9474,18 +9477,23 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
         d += is_utf8 ? UTF8SKIP(d) : 1;
         parse_ident(&s, &d, e, 1, is_utf8);
            *d = '\0';
-           while (s < PL_bufend && SPACE_OR_TAB(*s))
-               s++;
+            tmp_copline = CopLINE(PL_curcop);
+            while (s < PL_bufend && isSPACE(*s)) {
+                s = PEEKSPACE(s);
+            }
            if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
                 /* ${foo[0]} and ${foo{bar}} notation.  */
                if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest, 0)) {
                    const char * const brack =
                        (const char *)
                        ((*s == '[') ? "[...]" : "{...}");
+                    orig_copline = CopLINE(PL_curcop);
+                    CopLINE_set(PL_curcop, tmp_copline);
    /* diag_listed_as: Ambiguous use of %c{%s[...]} resolved to %c%s[...] */
                    Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
                        "Ambiguous use of %c{%s%s} resolved to %c%s%s",
                        funny, dest, brack, funny, dest, brack);
+                    CopLINE_set(PL_curcop, orig_copline);
                }
                bracket++;
                PL_lex_brackstack[PL_lex_brackets++] = (char)(XOPERATOR | XFAKEBRACK);
@@ -9507,9 +9515,12 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
            *d = '\0';
        }
 
-        while (s < PL_bufend && ( SPACE_OR_TAB(*s) || *s == '\n' ))
-           s++;
-
+        if ( !tmp_copline )
+            tmp_copline = CopLINE(PL_curcop);
+        while (s < PL_bufend && isSPACE(*s)) {
+            s = PEEKSPACE(s);
+        }
+           
         /* Expect to find a closing } after consuming any trailing whitespace.
          */
        if (*s == '}') {
@@ -9527,9 +9538,12 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
                                             SVs_TEMP | (is_utf8 ? SVf_UTF8 : 0) );
                    if (funny == '#')
                        funny = '@';
+                    orig_copline = CopLINE(PL_curcop);
+                    CopLINE_set(PL_curcop, tmp_copline);
                    Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
                        "Ambiguous use of %c{%"SVf"} resolved to %c%"SVf,
                        funny, tmp, funny, tmp);
+                    CopLINE_set(PL_curcop, orig_copline);
                }
            }
        }
@@ -9537,6 +9551,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
             /* Didn't find the closing } at the point we expected, so restore
                state such that the next thing to process is the opening { and */
            s = bracket;                /* let the parser handle it */
+            CopLINE_set(PL_curcop, orig_copline);
            *dest = '\0';
        }
     }