diff --git a/lib/perl5db.t b/lib/perl5db.t index 78336526eab4..24fa689b375d 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -3527,9 +3527,9 @@ EOS # https://github.com/Perl/perl5/issues/799 my $prog = <<'EOS'; sub problem { - $SIG{__DIE__} = sub { + $SIG{__DIE__} = sub { # The break point _should_ be set here. die " will set a break point here.\n"; - }; # The break point _should_ be set here. + }; warn "This line will run even if you enter .\n"; } &problem; @@ -3612,9 +3612,9 @@ EOS print "1\n"; eval <<'EOC'; sub problem { - $SIG{__DIE__} = sub { + $SIG{__DIE__} = sub { # The break point _should_ be set here. die " will set a break point here.\n"; - }; # The break point _should_ be set here. + }; warn "This line will run even if you enter .\n"; } EOC diff --git a/op.c b/op.c index a007149ae9d1..9e1ee84092bb 100644 --- a/op.c +++ b/op.c @@ -4725,7 +4725,15 @@ Perl_block_end(pTHX_ I32 floor, OP *seq) /* XXX Is the null PL_parser check necessary here? */ assert(PL_parser); /* Let’s find out under debugging builds. */ if (PL_parser && PL_parser->parsed_sub) { + + /* If this is an anonymous sub, it might have been declared in the + * middle of a statement. To avoid messing up the line numbering of + * that statement, note the copline prior to the newSTATEOP call + * and restore it straight afterwards. */ + const line_t saved_copline = PL_parser->copline; o = newSTATEOP(0, NULL, NULL); + PL_parser->copline = saved_copline; + op_null(o); retval = op_append_elem(OP_LINESEQ, retval, o); } @@ -11558,6 +11566,13 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, bool name_is_utf8 = o && !o_is_gv && SvUTF8(cSVOPo->op_sv); bool evanescent = FALSE; bool isBEGIN = FALSE; + + /* If this is an anonymous sub, it might have been declared in the + * middle of a statement. To avoid messing up the line numbering of + * that statement, note the copline now and restore it later. */ + const line_t note_copline = (!o && !o_is_gv) + ? PL_parser->copline : NOLINE; + OP *start = NULL; #ifdef PERL_DEBUG_READONLY_OPS OPSLAB *slab = NULL; @@ -12021,7 +12036,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, done: assert(!cv || evanescent || SvREFCNT((SV*)cv) != 0); if (PL_parser) - PL_parser->copline = NOLINE; + PL_parser->copline = note_copline; LEAVE_SCOPE(floor); assert(!cv || evanescent || SvREFCNT((SV*)cv) != 0); diff --git a/t/op/caller.t b/t/op/caller.t index e755a110eb4f..c50c68fd5e6b 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -315,10 +315,8 @@ sub dbdie { END "caller should not SEGV for eval '' stack frames"; -TODO: { - local $::TODO = 'RT #7165: line number should be consistent for multiline subroutine calls'; - fresh_perl_is(<<'EOP', "6\n9\n", {}, 'RT #7165: line number should be consistent for multiline subroutine calls'); - sub tagCall { +fresh_perl_is(<<'EOP', "6\n9\n", {}, 'RT #7165: line number should be consistent for multiline subroutine calls'); + sub tagCall { my ($package, $file, $line) = caller; print "$line\n"; } @@ -329,7 +327,6 @@ TODO: { tagCall sub {}; EOP -} $::testing_caller = 1; diff --git a/toke.c b/toke.c index 81043823c9ef..b60df1a71382 100644 --- a/toke.c +++ b/toke.c @@ -6844,7 +6844,13 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack) break; } - pl_yylval.ival = CopLINE(PL_curcop); + /* PL_copline contains the line number of the last-seen COP. + * CopLINE(PL_curcop) could have advanced past that. We + * likely want to save PL_curcop where possible to get + * more accurate line numbering for diagnostics/caller. */ + pl_yylval.ival = (PL_copline == NOLINE) + ? CopLINE(PL_curcop) : PL_copline; + PL_copline = NOLINE; /* invalidate current command line number */ TOKEN(formbrack ? PERLY_EQUAL_SIGN : PERLY_BRACE_OPEN); }