summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2020-04-27 21:53:43 +0100
committerDavid Mitchell <davem@iabyn.com>2020-04-27 21:53:43 +0100
commit2abf7efcc0ff8978340af661cb333175a899a84e (patch)
tree6874a50b9a3c4ef7d2b6807cf50409f4ba7532cb
parentc6b2e294d8420e0bf8a959617e087a086a43abc8 (diff)
downloadperl-2abf7efcc0ff8978340af661cb333175a899a84e.tar.gz
Revert "fixup to "avoid identical stack traces" - try 2"
This reverts commit ad89278aa25475fb03971aec66692e18e35d9c07.
-rw-r--r--MANIFEST1
-rw-r--r--op.c7
-rw-r--r--t/lib/GH_15109/Foo.pm9
-rw-r--r--t/op/caller.t22
4 files changed, 9 insertions, 30 deletions
diff --git a/MANIFEST b/MANIFEST
index 3f2f670747..b9e2a08f82 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5651,7 +5651,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 e810d466a8..cd2dc44229 100644
--- a/op.c
+++ b/op.c
@@ -11739,9 +11739,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));
- SAVEFREEOP(PL_curcop);
+ 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
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..9fc9a1ce39 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 => 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"
}
-
}