Perl_multideref_stringify: don't SEGV on null cv

This function is called by e.g. "perl -Dt" to display the multideref op:

    $ perl -Dt -e'$a->{foo}[1]'
    ...
    (-e:1)	multideref($a->{"foo"}[1])

On threaded builds, it needs to know the correct pad (and so the correct
cv too) so that it can access GVs and const SVs that have been moved to
the pad.

However with a sort code block (rather than a sort sub), S_deb_curcv()
returns null, so multideref_stringify() is called with a null CV. This
then SEGVs.

Although ideally S_deb_curcv() should be fixed, a function like
multideref_stringify(), which can be used for debugging, should be robust
in unexpected circumstances. So this commit makes it safe (although not
particularly useful) with a null CV:

    $ perl -Dt -e'@a = sort { $a->[$i] <=> $b->[$i] } [0], [1]'
    ...
    (-e:1)	sort
    (-e:1)	multideref(<NULLGV>->[<NULLGV>])
    (-e:1)	multideref(<NULLGV>->[<NULLGV>])

3 files changed, 33 insertions, 19 deletions

diff --git a/dump.c b/dump.c
index e69f30853a..926e5f8bcb 100644
--- a/dump.c
+++ b/dump.c
@@ -2323,7 +2323,8 @@ S_append_gv_name(pTHX_ GV *gv, SV *out)
 }
 
 #ifdef USE_ITHREADS
-#  define ITEM_SV(item) *av_fetch(comppad, (item)->pad_offset, FALSE);
+#  define ITEM_SV(item) (comppad ? \
+    *av_fetch(comppad, (item)->pad_offset, FALSE) : NULL);
 #else
 #  define ITEM_SV(item) UNOP_AUX_item_sv(item)
 #endif
@@ -2344,8 +2345,14 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
     int derefs = 0;
     SV *out = newSVpvn_flags("",0,SVs_TEMP);
 #ifdef USE_ITHREADS
-    PADLIST * const padlist = CvPADLIST(cv);
-    PAD *comppad = PadlistARRAY(padlist)[1];
+    PAD *comppad;
+
+    if (cv) {
+        PADLIST *padlist = CvPADLIST(cv);
+        comppad = PadlistARRAY(padlist)[1];
+    }
+    else
+        comppad = NULL;
 #endif
 
     PERL_ARGS_ASSERT_MULTIDEREF_STRINGIFY;
@@ -2372,7 +2379,8 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
             /* FALLTHROUGH */
         case MDEREF_AV_gvav_aelem:
             derefs = 1;
-            sv = ITEM_SV(++items);
+            items++;
+            sv = ITEM_SV(items);
             S_append_gv_name(aTHX_ (GV*)sv, out);
             goto do_elem;
             NOT_REACHED; /* NOTREACHED */
@@ -2381,7 +2389,8 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
             is_hash = TRUE;
             /* FALLTHROUGH */
         case MDEREF_AV_gvsv_vivify_rv2av_aelem:
-            sv = ITEM_SV(++items);
+            items++;
+            sv = ITEM_SV(items);
             S_append_gv_name(aTHX_ (GV*)sv, out);
             goto do_vivify_rv2xv_elem;
             NOT_REACHED; /* NOTREACHED */
@@ -2414,15 +2423,20 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
             switch (actions & MDEREF_INDEX_MASK) {
             case MDEREF_INDEX_const:
                 if (is_hash) {
-                    STRLEN cur;
-                    char *s;
-                    sv = ITEM_SV(++items);
-                    s = SvPV(sv, cur);
-                    pv_pretty(out, s, cur, 30,
-                                NULL, NULL,
-                                (PERL_PV_PRETTY_NOCLEAR
-                                |PERL_PV_PRETTY_QUOTE
-                                |PERL_PV_PRETTY_ELLIPSES));
+                    items++;
+                    sv = ITEM_SV(items);
+                    if (!sv)
+                        sv_catpvs_nomg(out, "???");
+                    else {
+                        STRLEN cur;
+                        char *s;
+                        s = SvPV(sv, cur);
+                        pv_pretty(out, s, cur, 30,
+                                    NULL, NULL,
+                                    (PERL_PV_PRETTY_NOCLEAR
+                                    |PERL_PV_PRETTY_QUOTE
+                                    |PERL_PV_PRETTY_ELLIPSES));
+                    }
                 }
                 else
                     Perl_sv_catpvf(aTHX_ out, "%"IVdf, (++items)->iv);
@@ -2431,7 +2445,8 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
                 S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
                 break;
             case MDEREF_INDEX_gvsv:
-                sv = ITEM_SV(++items);
+                items++;
+                sv = ITEM_SV(items);
                 S_append_gv_name(aTHX_ (GV*)sv, out);
                 break;
             }
diff --git a/embed.fnc b/embed.fnc
index 746d0ca4cd..79ed330466 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -334,7 +334,7 @@ ApR	|I32	|cxinc
 Afp	|void	|deb		|NN const char* pat|...
 Ap	|void	|vdeb		|NN const char* pat|NULLOK va_list* args
 Ap	|void	|debprofdump
-EXp	|SV*	|multideref_stringify	|NN const OP* o|NN CV *cv
+EXp	|SV*	|multideref_stringify	|NN const OP* o|NULLOK CV *cv
 Ap	|I32	|debop		|NN const OP* o
 Ap	|I32	|debstack
 Ap	|I32	|debstackptrs
diff --git a/proto.h b/proto.h
index af9648ef23..aa43b9504f 100644
--- a/proto.h
+++ b/proto.h
@@ -2770,10 +2770,9 @@ PERL_CALLCONV SV*	Perl_mro_set_private_data(pTHX_ struct mro_meta *const smeta,
 	assert(smeta); assert(which); assert(data)
 
 PERL_CALLCONV SV*	Perl_multideref_stringify(pTHX_ const OP* o, CV *cv)
-			__attribute__nonnull__(pTHX_1)
-			__attribute__nonnull__(pTHX_2);
+			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_MULTIDEREF_STRINGIFY	\
-	assert(o); assert(cv)
+	assert(o)
 
 PERL_CALLCONV NV	Perl_my_atof(pTHX_ const char *s)
 			__attribute__nonnull__(pTHX_1);