This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "fixup to "avoid identical stack traces""
authorNicolas R <atoomic@cpan.org>
Thu, 12 Mar 2020 21:14:26 +0000 (15:14 -0600)
committerNicolas R <atoomic@cpan.org>
Thu, 12 Mar 2020 21:14:26 +0000 (15:14 -0600)
This reverts commit fb8188b84d8a8f34f90aa9a8d9837892967f6b93.

Unfortunately this is causing some errors during global destruction
like:

Unbalanced string table refcount: (1) for "open_IN" during global destruction

It seems to be flapping, and recompiling Perl could see or not the
issue.

Upstream-URL: https://github.com/Perl/perl5/commit/fb8188b84d8a8f34f90aa9a8d9837892967f6b93

MANIFEST
op.c
t/lib/GH_15109/Foo.pm [deleted file]
t/op/caller.t

index 74a1863..7db314d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5647,7 +5647,6 @@ 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 7cf4e84..a3ad215 100644 (file)
--- a/op.c
+++ b/op.c
@@ -11598,8 +11598,10 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,
                  * 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));
+                Newx(PL_curcop, 1, COP);
+                StructCopy(&PL_compiling, PL_curcop, COP);
+                PL_curcop->op_slabbed = 0;
+                SAVEFREEPV(PL_curcop);
             }
 
             PUSHSTACKi(PERLSI_REQUIRE);
diff --git a/t/lib/GH_15109/Foo.pm b/t/lib/GH_15109/Foo.pm
deleted file mode 100644 (file)
index 1af2547..0000000
+++ /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;
index 865b005..9fc9a1c 100644 (file)
@@ -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 => 109 ); # some tests are run in a BEGIN block
 }
 
 my @c;
@@ -349,20 +349,6 @@ do './op/caller.pl' or die $@;
     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");
 }
 
 {
@@ -371,9 +357,11 @@ do './op/caller.pl' or die $@;
         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"
     }
-
 }