Skip to content

Commit fb8188b

Browse files
committed
fixup to "avoid identical stack traces"
GH #15109, #17567 My original fix for this issue, v5.31.6-141-gf2f32cd638 made a shallow copy of &PL_compiling. However, for non-default warning bits, this made two COPs share the malloced() cop_warnings, and bad things ensured. In particular this was flagged up in: GH #17567: "BBC: AYOUNG/OpenVZ-0.01.tar.gz" The fix in this commit is to do a deep copy of the COP using newSTATEOP().
1 parent 89561f3 commit fb8188b

File tree

4 files changed

+29
-9
lines changed

4 files changed

+29
-9
lines changed

MANIFEST

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5647,6 +5647,7 @@ t/lib/feature/switch Tests for enabling/disabling switch feature
56475647
t/lib/GH_15109/Apack.pm test Module for caller.t
56485648
t/lib/GH_15109/Bpack.pm test Module for caller.t
56495649
t/lib/GH_15109/Cpack.pm test Module for caller.t
5650+
t/lib/GH_15109/Foo.pm test Module for caller.t
56505651
t/lib/h2ph.h Test header file for h2ph
56515652
t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison
56525653
t/lib/locale/latin1 Part of locale.t in Latin 1

op.c

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11598,10 +11598,8 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,
1159811598
* to PL_compiling, IN_PERL_COMPILETIME/IN_PERL_RUNTIME
1159911599
* will give the wrong answer.
1160011600
*/
11601-
Newx(PL_curcop, 1, COP);
11602-
StructCopy(&PL_compiling, PL_curcop, COP);
11603-
PL_curcop->op_slabbed = 0;
11604-
SAVEFREEPV(PL_curcop);
11601+
PL_curcop = (COP*)newSTATEOP(PL_compiling.op_flags, NULL, NULL);
11602+
CopLINE_set(PL_curcop, CopLINE(&PL_compiling));
1160511603
}
1160611604

1160711605
PUSHSTACKi(PERLSI_REQUIRE);

t/lib/GH_15109/Foo.pm

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
# for use by caller.t for GH #15109
2+
3+
package Foo;
4+
5+
sub import {
6+
use warnings; # restore default warnings
7+
() = caller(1); # this used to cause valgrind errors
8+
}
9+
1;

t/op/caller.t

Lines changed: 17 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ BEGIN {
55
chdir 't' if -d 't';
66
require './test.pl';
77
set_up_inc('../lib');
8-
plan( tests => 109 ); # some tests are run in a BEGIN block
8+
plan( tests => 111 ); # some tests are run in a BEGIN block
99
}
1010

1111
my @c;
@@ -349,6 +349,20 @@ do './op/caller.pl' or die $@;
349349
like($Cpack::callers[$_], qr{GH_15109/Apack.pm:3}, "GH #15109 level $_") for 3..5;
350350
like($Cpack::callers[$_], qr{\(eval \d+\):1}, "GH #15109 level $_") for 6..8;
351351
like($Cpack::callers[$_], qr{caller\.t}, "GH #15109 level $_") for 9;
352+
353+
# GH #15109 followup - the original fix wasn't saving cop_warnings
354+
# correctly and this code used to crash or fail valgrind
355+
356+
my $w = 0;
357+
local $SIG{__WARN__} = sub { $w++ };
358+
eval q{
359+
use warnings;
360+
no warnings 'numeric'; # ensure custom cop_warnings
361+
use Foo; # this used to mess up warnings flags
362+
BEGIN { my $x = "foo" + 1; } # potential "numeric" warning
363+
};
364+
is ($@, "", "GH #15109 - eval okay");
365+
is ($w, 0, "GH #15109 - warnings restored");
352366
}
353367

354368
{
@@ -357,11 +371,9 @@ do './op/caller.pl' or die $@;
357371
my ($pkg, $file, $line) = caller;
358372
::is $file, 'virtually/op/caller.t', "BEGIN block sees correct caller filename";
359373
::is $line, 12345, "BEGIN block sees correct caller line";
360-
TODO: {
361-
local $::TODO = "BEGIN blocks have wrong caller package [perl #129239]";
362-
::is $pkg, 'RT129239', "BEGIN block sees correct caller package";
363-
}
374+
::is $pkg, 'RT129239', "BEGIN block sees correct caller package";
364375
#line 12345 "virtually/op/caller.t"
365376
}
377+
366378
}
367379

0 commit comments

Comments
 (0)