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>])

diff --git a/dump.c b/dump.c
index e69f308..926e5f8 100644 (file)
--- 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 746d0ca..79ed330 100644 (file)
--- 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 af9648e..aa43b95 100644 (file)
--- 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);