Commit ffa804ca27 for perl
commit ffa804ca27fa678334fd13757228bf841ffb9c1f
Author: Richard Leach <rich+perl@hyphen-dash-hyphen.info>
Date: Tue Apr 28 11:50:41 2026 +0000
Note (yyl_leftcurly) & restore (newATTRSUB_x) line numbers for anon subs
Declaring an anonymous subroutine in the middle of a statement is likely
to result in an inaccurate line number being stored in the COP preceding
the statement. This is because line number information is discarded
during parsing and creation of the anonymous subroutine.
This commit attempts to store and restore a more accurate line number
for the COP. This will improve the accuracy of line numbers emitted by
diagnostic messages and `caller()`. **_Tests containing hardcoded line
numbers may require updating as a result of this commit._**
This (previously) TODO test from _caller.t_ shows the difference:
```
sub tagCall {
my ($package, $file, $line) = caller;
print "$line\n";
}
tagCall # Line number 6 correctly reported before & after
"abc";
tagCall # Line number 9 correctly reported with this commit
sub {}; # Line number 10 incorrectly reported previously
```
Changes in line numbering could also affect where breaking on a function
occurs in the perl debugger. This can be seen in the included change to
_perl5db.t_, where breaking on entry to `problem()` now occurs at the
start of the subroutine, rather than after the anonymous subroutine
declaration:
```
sub problem {
$SIG{__DIE__} = sub { # Breaking on problem() now lands here
die "<b problem> will set a break point here.\n";
}; # Breaking on problem() used to land here
```
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 78336526ea..24fa689b37 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 "<b problem> will set a break point here.\n";
- }; # The break point _should_ be set here.
+ };
warn "This line will run even if you enter <c problem>.\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 "<b problem> will set a break point here.\n";
- }; # The break point _should_ be set here.
+ };
warn "This line will run even if you enter <c problem>.\n";
}
EOC
diff --git a/op.c b/op.c
index 3c8d9ed0e3..39a3d00a1f 100644
--- a/op.c
+++ b/op.c
@@ -4808,7 +4808,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);
}
@@ -11874,6 +11882,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;
@@ -12340,7 +12355,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/pod/perldelta.pod b/pod/perldelta.pod
index bb70d42a45..f191d3d547 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -405,6 +405,19 @@ manager will later use a regex to expand these into links.
=item *
+Line number information is stored rather than discarded when an anonymous
+subroutine is encountered during compilation. This should improve the
+accuracy of line numbers emitted by diagnostic messages and `caller()`
+for code following an anonymous subroutine declaration.
+
+Note that (i) this change could break any tests that hardcode the
+less-accurate line numbers (ii) further improvements to line number
+accuracy may follow within this development cycle.
+
+[GH #24396]
+
+=item *
+
XXX
=back
diff --git a/t/op/caller.t b/t/op/caller.t
index 802c3502e2..f1d3d4a6a0 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 472548eff8..df50a9f287 100644
--- a/toke.c
+++ b/toke.c
@@ -7052,7 +7052,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);
}