Skip to content

Commit

Permalink
Perl_runops_wrap((): don't mortalise NULLs
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
iabyn committed Aug 16, 2023
1 parent dbc9c91 commit ce8d75e
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 3 deletions.
8 changes: 6 additions & 2 deletions run.c
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
18 changes: 17 additions & 1 deletion t/op/grep.t
Original file line number Diff line number Diff line change
Expand Up @@ -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)]);
Expand Down Expand Up @@ -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");
}

0 comments on commit ce8d75e

Please sign in to comment.