[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.

diff --git a/pp_ctl.c b/pp_ctl.c
index 0e62d50..19657d8 100644 (file)
--- 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 (file)
--- 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) }