From ce8d75ef6b1fc2ff9f508e94e9855abe7a43a346 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Sat, 11 Mar 2023 22:14:28 +0000
Subject: [PATCH] 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.
---
 run.c       |  8 ++++++--
 t/op/grep.t | 18 +++++++++++++++++-
 2 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/run.c b/run.c
index 7d11ae8b48..8dd618ace0 100644
--- a/run.c
+++ b/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;
diff --git a/t/op/grep.t b/t/op/grep.t
index 8ab9a8aa4d..42a8903717 100644
--- a/t/op/grep.t
+++ b/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");
+}