mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 08:38:23 +00:00
Perl_runops_wrap((): don't mortalise NULLs
This function was doing a delayed ref count decrement of all the SVs it had previously temporarily incremented, by mortalising each one. For efficiency it was just doing a Copy() of a block of SVs addresses from the argument stack to the TEMPs stack. However, the TEMPs stack can't cope with NULL pointers, while there are sometimes NULL pointers on the argument stack - in particular, while doing a map, any temporary holes in the stack are set to NULL on PERL_RC_STACK builds. The fix is simple - copy individual non-NULL addresses to the TEMPS stack rather than doing a block copy.
This commit is contained in:
parent
dbc9c91513
commit
ce8d75ef6b
8
run.c
8
run.c
@ -127,9 +127,13 @@ Perl_runops_wrap(pTHX)
|
||||
* upwards; but this may prematurely free them, so
|
||||
* mortalise them instead */
|
||||
EXTEND_MORTAL(n);
|
||||
Copy(PL_stack_base + cut, PL_tmps_stack + PL_tmps_ix + 1, n, SV*);
|
||||
PL_tmps_ix += n;
|
||||
for (SSize_t i = 0; i < n; i ++) {
|
||||
SV* sv = PL_stack_base[cut + i];
|
||||
if (sv)
|
||||
PL_tmps_stack[++PL_tmps_ix] = sv;
|
||||
}
|
||||
}
|
||||
|
||||
I32 sp1 = PL_stack_sp - PL_stack_base + 1;
|
||||
PL_curstackinfo->si_stack_nonrc_base =
|
||||
old_base > sp1 ? sp1 : old_base;
|
||||
|
||||
18
t/op/grep.t
18
t/op/grep.t
@ -10,7 +10,7 @@ BEGIN {
|
||||
set_up_inc( qw(. ../lib) );
|
||||
}
|
||||
|
||||
plan( tests => 76 );
|
||||
plan( tests => 77 );
|
||||
|
||||
{
|
||||
my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
|
||||
@ -278,3 +278,19 @@ package FOO {
|
||||
bless[];
|
||||
} 1,2,3;
|
||||
}
|
||||
|
||||
# At one point during development, this code SEGVed on PERL_RC_STACK
|
||||
# builds, as NULL filler pointers on the stack during a map were getting
|
||||
# copied to the tmps stack, and the tmps stack can't handle NULL pointers.
|
||||
# The bug only occurred in IO::Socket::SSL rather than core. It required
|
||||
# perl doing a call_sv(.., G_EVAL) to call the sub containing the map. In
|
||||
# the original bug this was triggered by a use/require, but here we use a
|
||||
# BEGIN within an eval as simpler variant.
|
||||
|
||||
{
|
||||
my @res;
|
||||
eval q{
|
||||
BEGIN { @res = map { $_ => eval {die} || -1 } qw( ABC XYZ); }
|
||||
};
|
||||
is("@res", "ABC -1 XYZ -1", "no NULL tmps");
|
||||
}
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user