[MERGE] Revert BEGIN { caller() } fixups

These commits were intended to fix a problem with stack backtraces
reporting wrong file and line numbers in nested use's.

A side-effect of the commits was to fix the package name returned by
caller() too; but quite a few distributions were relying on the old
behaviour.

So for now, revert to the old behaviour and re-address after 5.32.0 is
released.

The reverted commits are:

v5.31.6-141-gf2f32cd638 avoid identical stack traces
v5.31.9-122-gee428a211d docs: clarify effect of $^H, %^H, ${^WARNING_BITS}
v5.31.9-162-gad89278aa2 fixup to "avoid identical stack traces" - try 2

8 files changed, 6 insertions, 100 deletions

diff --git a/MANIFEST b/MANIFEST
index 3f2f670747..95d6e441ca 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5648,10 +5648,6 @@ 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/GH_15109/Foo.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 e810d466a8..322d6d6641 100644
--- a/op.c
+++ b/op.c
@@ -11722,31 +11722,10 @@ 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.
-                 */
-                PL_curcop = (COP*)newSTATEOP(PL_compiling.op_flags, NULL, NULL);
-                CopLINE_set(PL_curcop, CopLINE(&PL_compiling));
-                SAVEFREEOP(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/pod/perlvar.pod b/pod/perlvar.pod
index 1d04f532f7..0d2da09773 100644
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -1892,10 +1892,6 @@ It has the same scoping as the C<$^H> and C<%^H> variables.  The exact
 values are considered internal to the L<warnings> pragma and may change
 between versions of Perl.
 
-Each time a statement completes being compiled, the current value of
-C<${^WARNING_BITS}> is stored with that statement, and can later be
-retrieved via C<(caller($level))[9]>.
-
 This variable was added in Perl v5.6.0.
 
 =item $OS_ERROR
@@ -2188,10 +2184,6 @@ This variable contains compile-time hints for the Perl interpreter.  At the
 end of compilation of a BLOCK the value of this variable is restored to the
 value when the interpreter started to compile the BLOCK.
 
-Each time a statement completes being compiled, the current value of
-C<$^H> is stored with that statement, and can later be retrieved via
-C<(caller($level))[8]>.
-
 When perl begins to parse any block construct that provides a lexical scope
 (e.g., eval body, required file, subroutine body, loop body, or conditional
 block), the existing value of C<$^H> is saved, but its value is left unchanged.
@@ -2240,10 +2232,6 @@ L<perlpragma>.   All the entries are stringified when accessed at
 runtime, so only simple values can be accommodated.  This means no
 pointers to objects, for example.
 
-Each time a statement completes being compiled, the current value of
-C<%^H> is stored with that statement, and can later be retrieved via
-C<(caller($level))[10]>.
-
 When putting items into C<%^H>, in order to avoid conflicting with other
 users of the hash there is a convention regarding which keys to use.
 A module should use only keys that begin with the module's name (the
diff --git a/t/lib/GH_15109/Apack.pm b/t/lib/GH_15109/Apack.pm
deleted file mode 100644
index fa52ec8b53..0000000000
--- a/t/lib/GH_15109/Apack.pm
+++ /dev/null
@@ -1,4 +0,0 @@
-# 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
deleted file mode 100644
index f9421c813f..0000000000
--- a/t/lib/GH_15109/Bpack.pm
+++ /dev/null
@@ -1,4 +0,0 @@
-# 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
deleted file mode 100644
index 94c409b05c..0000000000
--- a/t/lib/GH_15109/Cpack.pm
+++ /dev/null
@@ -1,11 +0,0 @@
-# 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/lib/GH_15109/Foo.pm b/t/lib/GH_15109/Foo.pm
deleted file mode 100644
index 1af25470c6..0000000000
--- a/t/lib/GH_15109/Foo.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-# for use by caller.t for GH #15109
-
-package Foo;
-
-sub import {
-    use warnings; # restore default warnings
-    () = caller(1); # this used to cause valgrind errors
-}
-1;
diff --git a/t/op/caller.t b/t/op/caller.t
index 865b005bf5..564d140cc0 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 => 111 ); # some tests are run in a BEGIN block
+    plan( tests => 97 ); # some tests are run in a BEGIN block
 }
 
 my @c;
@@ -335,45 +335,16 @@ $::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;
-
-    # GH #15109 followup - the original fix wasn't saving cop_warnings
-    # correctly and this code used to crash or fail valgrind
-
-    my $w = 0;
-    local $SIG{__WARN__} = sub { $w++ };
-    eval q{
-        use warnings;
-        no warnings 'numeric'; # ensure custom cop_warnings
-        use Foo;      # this used to mess up warnings flags
-        BEGIN { my $x = "foo" + 1; } # potential "numeric" warning
-    };
-    is ($@, "", "GH #15109 - eval okay");
-    is ($w, 0, "GH #15109 - warnings restored");
-}
-
 {
     package RT129239;
     BEGIN {
         my ($pkg, $file, $line) = caller;
         ::is $file, 'virtually/op/caller.t', "BEGIN block sees correct caller filename";
         ::is $line, 12345,                   "BEGIN block sees correct caller line";
-        ::is $pkg, 'RT129239',               "BEGIN block sees correct caller package";
+        TODO: {
+            local $::TODO = "BEGIN blocks have wrong caller package [perl #129239]";
+            ::is $pkg, 'RT129239',               "BEGIN block sees correct caller package";
+        }
 #line 12345 "virtually/op/caller.t"
     }
-
 }
-