diff --git a/MANIFEST b/MANIFEST index 2656e612505d..a92fe86f8de3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5476,6 +5476,9 @@ t/lib/feature/nonesuch Tests for enabling/disabling nonexistent feature t/lib/feature/removed Tests for enabling/disabling removed feature t/lib/feature/say Tests for enabling/disabling say feature t/lib/feature/switch Tests for enabling/disabling switch feature +t/lib/GH_15109/Apack.pm test Module for caller.t +t/lib/GH_15109/Bpack.pm test Module for caller.t +t/lib/GH_15109/Cpack.pm test Module for caller.t t/lib/h2ph.h Test header file for h2ph t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison t/lib/locale/latin1 Part of locale.t in Latin 1 diff --git a/op.c b/op.c index 60b362757525..cd57762b2fe4 100644 --- a/op.c +++ b/op.c @@ -10460,10 +10460,32 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname, (void)CvGV(cv); if (floor) LEAVE_SCOPE(floor); ENTER; + + SAVEVPTR(PL_curcop); + if (PL_curcop == &PL_compiling) { + /* Avoid pushing the "global" &PL_compiling onto the + * context stack. For example, a stack trace inside + * nested use's would show all calls coming from whoever + * most recently updated PL_compiling.cop_file and + * cop_line. So instead, temporarily set PL_curcop to a + * private copy of &PL_compiling. PL_curcop will soon be + * set to point back to &PL_compiling anyway but only + * after the temp value has been pushed onto the context + * stack as blk_oldcop. + * This is slightly hacky, but necessary. Note also + * that in the brief window before PL_curcop is set back + * to PL_compiling, IN_PERL_COMPILETIME/IN_PERL_RUNTIME + * will give the wrong answer. + */ + Newx(PL_curcop, 1, COP); + StructCopy(&PL_compiling, PL_curcop, COP); + PL_curcop->op_slabbed = 0; + SAVEFREEPV(PL_curcop); + } + PUSHSTACKi(PERLSI_REQUIRE); SAVECOPFILE(&PL_compiling); SAVECOPLINE(&PL_compiling); - SAVEVPTR(PL_curcop); DEBUG_x( dump_sub(gv) ); Perl_av_create_and_push(aTHX_ &PL_beginav, MUTABLE_SV(cv)); diff --git a/t/lib/GH_15109/Apack.pm b/t/lib/GH_15109/Apack.pm new file mode 100644 index 000000000000..fa52ec8b537a --- /dev/null +++ b/t/lib/GH_15109/Apack.pm @@ -0,0 +1,4 @@ +# for use by caller.t for GH #15109 +package Apack; +use Bpack; +1; diff --git a/t/lib/GH_15109/Bpack.pm b/t/lib/GH_15109/Bpack.pm new file mode 100644 index 000000000000..f9421c813fc2 --- /dev/null +++ b/t/lib/GH_15109/Bpack.pm @@ -0,0 +1,4 @@ +# for use by caller.t for GH #15109 +package Bpack; +use Cpack; +1; diff --git a/t/lib/GH_15109/Cpack.pm b/t/lib/GH_15109/Cpack.pm new file mode 100644 index 000000000000..94c409b05ce3 --- /dev/null +++ b/t/lib/GH_15109/Cpack.pm @@ -0,0 +1,11 @@ +# for use by caller.t for GH #15109 +package Cpack; + + +my $i = 0; + +while (my ($package, $file, $line) = caller($i++)) { + push @Cpack::callers, "$file:$line"; +} + +1; diff --git a/t/op/caller.t b/t/op/caller.t index 564d140cc0c2..9fc9a1ce3921 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; set_up_inc('../lib'); - plan( tests => 97 ); # some tests are run in a BEGIN block + plan( tests => 109 ); # some tests are run in a BEGIN block } my @c; @@ -335,6 +335,22 @@ $::testing_caller = 1; do './op/caller.pl' or die $@; +# GH #15109 +# See that callers within a nested series of 'use's gets the right +# filenames. +{ + local @INC = 'lib/GH_15109/'; + # Apack use's Bpack which use's Cpack which populates @Cpack::caller + # with the file:N of all the callers + eval 'use Apack; 1'; + is($@, "", "GH #15109 - eval"); + is (scalar(@Cpack::callers), 10, "GH #15109 - callers count"); + like($Cpack::callers[$_], qr{GH_15109/Bpack.pm:3}, "GH #15109 level $_") for 0..2; + like($Cpack::callers[$_], qr{GH_15109/Apack.pm:3}, "GH #15109 level $_") for 3..5; + like($Cpack::callers[$_], qr{\(eval \d+\):1}, "GH #15109 level $_") for 6..8; + like($Cpack::callers[$_], qr{caller\.t}, "GH #15109 level $_") for 9; +} + { package RT129239; BEGIN { @@ -348,3 +364,4 @@ do './op/caller.pl' or die $@; #line 12345 "virtually/op/caller.t" } } +