In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b2ef6d44c7d3e6463abb48b4fc82b08e88b5127a?hp=0d135d25496046c60a195844bcab41bce8b8f5cc>
- Log ----------------------------------------------------------------- commit b2ef6d44c7d3e6463abb48b4fc82b08e88b5127a Author: Father Chrysostomos <[email protected]> Date: Fri Dec 10 21:46:13 2010 -0800 [perl #68712] caller() filenames broken by "use" require() sets the file name for PL_compiling but localises it to the calling scope, not the scope that it creates. As a result, caller() during or after require (in the same scope that require was called from) will return the wrong file name for whichever code is being com- piled at the time and any scope sharing the same CopFILE (or something like that): $ ./miniperl -Ilib -e 'BEGIN{require strict; warn join ", ", caller(0)}' main, lib/strict.pm, 1, main::BEGIN, 1, , , , 0, , at -e line 1. ^^^^^^^^^^^^^ should be -e This commit moves the SAVECOPFILE_FREE and CopFILE_set down below the ENTER_with_name to put it in the right scope. It was in its existing location presumably because namesv needed to be freed before any code that could die (and the CopFILE_set call reads a PV allocated for namesv). So now namesv is mortalised instead. The if(tryrsfp) is no longer necessary, as that code is never reached when tryrsfp is false. The block in between that sets %INC was reading CopFILE. It can simply use the same tryname variable that is passed to CopFILE_set. ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 10 ++++------ t/op/caller.t | 10 ++++++++-- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index 0e62d50..19657d8 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3770,11 +3770,7 @@ PP(pp_require) } } } - if (tryrsfp) { - SAVECOPFILE_FREE(&PL_compiling); - CopFILE_set(&PL_compiling, tryname); - } - SvREFCNT_dec(namesv); + sv_2mortal(namesv); if (!tryrsfp) { if (PL_op->op_type == OP_REQUIRE) { if(errno == EMFILE) { @@ -3815,7 +3811,7 @@ PP(pp_require) /* Check whether a hook in @INC has already filled %INC */ if (!hook_sv) { (void)hv_store(GvHVn(PL_incgv), - unixname, unixlen, newSVpv(CopFILE(&PL_compiling),0),0); + unixname, unixlen, newSVpv(tryname,0),0); } else { SV** const svp = hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0); if (!svp) @@ -3825,6 +3821,8 @@ PP(pp_require) ENTER_with_name("eval"); SAVETMPS; + SAVECOPFILE_FREE(&PL_compiling); + CopFILE_set(&PL_compiling, tryname); lex_start(NULL, tryrsfp, 0); SAVEHINTS(); diff --git a/t/op/caller.t b/t/op/caller.t index c6d4f61..44c5ae5 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -5,12 +5,12 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan( tests => 80 ); + plan( tests => 81 ); } my @c; -print "# Tests with caller(0)\n"; +BEGIN { print "# Tests with caller(0)\n"; } @c = caller(0); ok( (!...@c), "caller(0) in main program" ); @@ -34,6 +34,12 @@ $fooref -> (); is( $c[3], "main::__ANON__", "deleted subroutine name" ); ok( $c[4], "hasargs true with deleted sub" ); +BEGIN { + require strict; + is +(caller 0)[1], __FILE__, + "[perl #68712] filenames after require in a BEGIN block" +} + print "# Tests with caller(1)\n"; sub f { @c = caller(1) } -- Perl5 Master Repository
