In perl.git, the branch smoke-me/warning-line-numbers has been updated <http://perl5.git.perl.org/perl.git/commitdiff/eaf37fd2aa62883395fc6f07b586dc94d8fc1649?hp=13e259f2566a0cad6e3d7b149b13e15b20c1768a>
- Log ----------------------------------------------------------------- commit eaf37fd2aa62883395fc6f07b586dc94d8fc1649 Author: Nicholas Clark <[email protected]> Date: Mon Aug 13 22:00:07 2012 +0200 newXS_len_flags() shouldn't change the line number on PL_curcop when warning. This can actually generate incorrect line numbers in runtime warnings, when XSUBs are redefined from calls made from BEGIN blocks, and the line number from the opening brace of the begin block is mashed with the filename of the current line. For compiletime warnings, PL_curcop == &PL_compiling, so the line numbers will be correct whether taken from PL_compiling or PL_parser. This code dates back to perl-5.000, when it was added to newXS(). It appears to be a copy of code present in newSUB() since alpha 2. M op.c M t/lib/warnings/op commit fd5c7c6706decbccfee91cb35323fb3ce8c8f9b9 Author: Nicholas Clark <[email protected]> Date: Wed Aug 8 22:59:19 2012 +0200 Test that the warning for "can be 0, test with defined" is for the start. The Perl interpreter is careful to use the line number of the start of the 'Value of %s can be "0"; test with defined()" warning, but there were no tests for this. M op.c M t/lib/warnings/op commit aeb451653a2d4b2dc9c4c6ba3a059ad244fb56cb Author: Nicholas Clark <[email protected]> Date: Wed Aug 8 22:23:29 2012 +0200 Test that the warning for "Found = in conditional" is for the start line. The Perl interpreter is careful to use the line number of the start of the "Found = in conditional", but there were no tests for this. M op.c M t/lib/warnings/op commit 3621e8fa938d3b16047658859a799e39d6e4c488 Author: Nicholas Clark <[email protected]> Date: Wed Aug 8 16:24:57 2012 +0200 Test that the line number for a "sub redefined" warning is for the start. The Perl interpreter is careful to use the line number of the start of a subroutine's redefinition for the warning, but there were no tests for this. M op.c M t/lib/warnings/op ----------------------------------------------------------------------- Summary of changes: op.c | 16 ++++++++++------ t/lib/warnings/op | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 6 deletions(-) diff --git a/op.c b/op.c index f3a0018..97975ea 100644 --- a/op.c +++ b/op.c @@ -1085,8 +1085,11 @@ S_scalarboolean(pTHX_ OP *o) if (ckWARN(WARN_SYNTAX)) { const line_t oldline = CopLINE(PL_curcop); - if (PL_parser && PL_parser->copline != NOLINE) + if (PL_parser && PL_parser->copline != NOLINE) { + /* This ensures that warnings are reported at the first line + of the conditional, not the last. */ CopLINE_set(PL_curcop, PL_parser->copline); + } Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Found = in conditional, should be =="); CopLINE_set(PL_curcop, oldline); } @@ -5832,6 +5835,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) } if (warnop) { const line_t oldline = CopLINE(PL_curcop); + /* This ensures that warnings are reported at the first line + of the construction, not the last. */ CopLINE_set(PL_curcop, PL_parser->copline); Perl_warner(aTHX_ packWARN(WARN_MISC), "Value of %s%s can be \"0\"; test with defined()", @@ -7018,8 +7023,11 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, #endif ) { const line_t oldline = CopLINE(PL_curcop); - if (PL_parser && PL_parser->copline != NOLINE) + if (PL_parser && PL_parser->copline != NOLINE) { + /* This ensures that warnings are reported at the first + line of a redefinition, not a last. */ CopLINE_set(PL_curcop, PL_parser->copline); + } report_redefined_cv(cSVOPo->op_sv, cv, &const_sv); CopLINE_set(PL_curcop, oldline); #ifdef PERL_MAD @@ -7425,14 +7433,10 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len, /* Redundant check that allows us to avoid creating an SV most of the time: */ if (CvCONST(cv) || ckWARN(WARN_REDEFINE)) { - const line_t oldline = CopLINE(PL_curcop); - if (PL_parser && PL_parser->copline != NOLINE) - CopLINE_set(PL_curcop, PL_parser->copline); report_redefined_cv(newSVpvn_flags( name,len,(flags&SVf_UTF8)|SVs_TEMP ), cv, const_svp); - CopLINE_set(PL_curcop, oldline); } SvREFCNT_dec(cv); cv = NULL; diff --git a/t/lib/warnings/op b/t/lib/warnings/op index 4f33700..69c3cd3 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -106,10 +106,15 @@ __END__ # op.c use warnings 'syntax' ; 1 if $a = 1 ; +1 if $a + = 1 ; no warnings 'syntax' ; 1 if $a = 1 ; +1 if $a + = 1 ; EXPECT Found = in conditional, should be == at - line 3. +Found = in conditional, should be == at - line 4. ######## # op.c use warnings 'syntax' ; @@ -664,28 +669,43 @@ Bareword found in conditional at - line 3. use warnings 'misc' ; open FH, "<abc" ; $x = 1 if $x = <FH> ; +$x = 1 if $x + = <FH> ; no warnings 'misc' ; $x = 1 if $x = <FH> ; +$x = 1 if $x + = <FH> ; EXPECT Value of <HANDLE> construct can be "0"; test with defined() at - line 4. +Value of <HANDLE> construct can be "0"; test with defined() at - line 5. ######## # op.c use warnings 'misc' ; opendir FH, "." ; $x = 1 if $x = readdir FH ; +$x = 1 if $x + = readdir FH ; no warnings 'misc' ; $x = 1 if $x = readdir FH ; +$x = 1 if $x + = readdir FH ; closedir FH ; EXPECT Value of readdir() operator can be "0"; test with defined() at - line 4. +Value of readdir() operator can be "0"; test with defined() at - line 5. ######## # op.c use warnings 'misc' ; $x = 1 if $x = <*> ; +$x = 1 if $x + = <*> ; no warnings 'misc' ; $x = 1 if $x = <*> ; +$x = 1 if $x + = <*> ; EXPECT Value of glob construct can be "0"; test with defined() at - line 3. +Value of glob construct can be "0"; test with defined() at - line 4. ######## # op.c use warnings 'misc' ; @@ -726,10 +746,15 @@ EXPECT use warnings 'redefine' ; sub fred {} sub fred {} +sub fred { # warning should be for this line +} no warnings 'redefine' ; sub fred {} +sub fred { +} EXPECT Subroutine fred redefined at - line 4. +Subroutine fred redefined at - line 5. ######## # op.c use warnings 'redefine' ; @@ -1479,3 +1504,24 @@ sub á áÆ () { 1 } EXPECT Constant subroutine main::á áÆ redefined at - line 5. ######## +# OPTION regex +sub DynaLoader::dl_error {}; +use warnings; +# We're testing that the warnings report the same line number: +eval <<'EOC' or die $@; +{ + DynaLoader::boot_DynaLoader("DynaLoader"); +} +EOC +eval <<'EOC' or die $@; +BEGIN { + DynaLoader::boot_DynaLoader("DynaLoader"); +} +1 +EOC +EXPECT +OPTION regex +\ASubroutine DynaLoader::dl_error redefined at \(eval 1\) line 2\. +(?s).* +Subroutine DynaLoader::dl_error redefined at \(eval 2\) line 2\. +######## -- Perl5 Master Repository
