In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d787f4a5ba95039e3f0b8f63ebc649cde1011c69?hp=4a7d38e775a8ed02578c490e2e20173b020c5fca>
- Log ----------------------------------------------------------------- commit d787f4a5ba95039e3f0b8f63ebc649cde1011c69 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 502e5101caadccb8d4d7ffd810c78d57c81a4cb7 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 2b7cdddeb97baa9e06d2bd4f7931d608e8dde565 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 2d4e17002f84f407fd95e491979a0bafccc2a0f8 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 14ca6fc..7305ab5 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); } @@ -5831,6 +5834,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()", @@ -7017,8 +7022,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 the 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 @@ -7424,14 +7432,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
