avoid identical stack traces

GH #15109

The output of caller() (e.g. as produced by carp::Confess) produces
multiple identical outputs when within a nested use/require. This is
because at the time of calling the 'BEGIN { require ... }', PL_curcop is
set to &PL_compiling, which is a fixed buffer within the interpreter,
whose individual file and line fields are saved and restored when doing
a new require/eval. This means that within the innermost require,
PL_compiling has file:lineno of the innermost source file, and multiple
saved PL_curcop values in the context stack frames all point to the same
&PL_copmpiling.  So all levels of the stack trace appear to come from the
innermost file.

This commit fixes this (after a fashion) by, at the start of calling a
BEGIN, making PL_curcop point to a temporary copy of PL_compiling
instead.

This is all a bit of a hack.

1 files changed, 23 insertions, 1 deletions

diff --git a/op.c b/op.c
index fcd29dd4e7..de1e1f10b6 100644
--- a/op.c
+++ b/op.c
@@ -11525,10 +11525,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));