Don't leak stderr from 'git describe' in cmpVERSION

[perl5.git] / dump.c

diff --git a/dump.c b/dump.c
index 3b3a74f..4eadad0 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -672,8 +672,6 @@ S_pm_description(pTHX_ const PMOP *pm)
             if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
                 sv_catpv(desc, ",ALL");
         }
-        if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
-            sv_catpv(desc, ",SKIPWHITE");
     }
 
     append_flags(desc, pmflags, pmflags_flags_names);
@@ -943,6 +941,12 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                if (o->op_private & OPpLVAL_DEFER)
                    sv_catpv(tmpsv, ",LVAL_DEFER");
            }
+           else if (optype == OP_RV2HV || optype == OP_PADHV) {
+             if (o->op_private & OPpMAYBE_TRUEBOOL)
+               sv_catpvs(tmpsv, ",OPpMAYBE_TRUEBOOL");
+             if (o->op_private & OPpTRUEBOOL)
+               sv_catpvs(tmpsv, ",OPpTRUEBOOL");
+           }
            else {
                if (o->op_private & HINT_STRICT_REFS)
                    sv_catpv(tmpsv, ",STRICT_REFS");
@@ -1411,12 +1415,10 @@ const struct flag_to_name regexp_flags_names[] = {
     {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
     {RXf_USE_INTUIT_ML,   "USE_INTUIT_ML,"},
     {RXf_INTUIT_TAIL,     "INTUIT_TAIL,"},
-    {RXf_SPLIT,           "SPLIT,"},
     {RXf_COPY_DONE,       "COPY_DONE,"},
     {RXf_TAINTED_SEEN,    "TAINTED_SEEN,"},
     {RXf_TAINTED,         "TAINTED,"},
     {RXf_START_ONLY,      "START_ONLY,"},
-    {RXf_SKIPWHITE,       "SKIPWHITE,"},
     {RXf_WHITE,           "WHITE,"},
     {RXf_NULL,            "NULL,"},
 };
@@ -1610,7 +1612,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     }
 
     if (type <= SVt_PVLV && !isGV_with_GP(sv)) {
-       if (SvPVX_const(sv)) {
+       const bool re = isREGEXP(sv);
+       const char * const ptr =
+           re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
+       if (ptr) {
            STRLEN delta;
            if (SvOOK(sv)) {
                SvOOK_offset(sv, delta);
@@ -1619,18 +1624,22 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            } else {
                delta = 0;
            }
-           Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
+           Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(ptr));
            if (SvOOK(sv)) {
                PerlIO_printf(file, "( %s . ) ",
-                             pv_display(d, SvPVX_const(sv) - delta, delta, 0,
+                             pv_display(d, ptr - delta, delta, 0,
                                         pvlim));
            }
-           PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
+           PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
+                                                re ? 0 : SvLEN(sv),
+                                                pvlim));
            if (SvUTF8(sv)) /* the 6?  \x{....} */
                PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
            PerlIO_printf(file, "\n");
            Perl_dump_indent(aTHX_ level, file, "  CUR = %"IVdf"\n", (IV)SvCUR(sv));
-           Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n", (IV)SvLEN(sv));
+           if (!re)
+               Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n",
+                                      (IV)SvLEN(sv));
        }
        else
            Perl_dump_indent(aTHX_ level, file, "  PV = 0\n");
@@ -1918,7 +1927,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                                 (IV)CvXSUBANY(sv).any_i32);
            }
        }
-       do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
+       if (CvNAMED(sv))
+           Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n",
+                                  HEK_KEY(CvNAME_HEK((CV *)sv)));
+       else do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
        Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
        Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
        Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
@@ -1953,6 +1965,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
                    dumpops, pvlim);
        }
+       if (isREGEXP(sv)) goto dumpregexp;
        if (!isGV_with_GP(sv))
            break;
        Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", GvNAME(sv));
@@ -2021,8 +2034,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv));
        break;
     case SVt_REGEXP:
+      dumpregexp:
        {
-           struct regexp * const r = (struct regexp *)SvANY(sv);
+           struct regexp * const r = ReANY((REGEXP*)sv);
            flags = RX_EXTFLAGS((REGEXP*)sv);
            sv_setpv(d,"");
            append_flags(d, flags, regexp_flags_names);
@@ -2050,6 +2064,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                                (UV)(r->pre_prefix));
            Perl_dump_indent(aTHX_ level, file, "  SUBLEN = %"IVdf"\n",
                                (IV)(r->sublen));
+           Perl_dump_indent(aTHX_ level, file, "  SUBOFFSET = %"IVdf"\n",
+                               (IV)(r->suboffset));
+           Perl_dump_indent(aTHX_ level, file, "  SUBCOFFSET = %"IVdf"\n",
+                               (IV)(r->subcoffset));
            if (r->subbeg)
                Perl_dump_indent(aTHX_ level, file, "  SUBBEG = 0x%"UVxf" %s\n",
                            PTR2UV(r->subbeg),
@@ -2123,6 +2141,8 @@ Perl_runops_debug(pTHX)
            if (DEBUG_t_TEST_) debop(PL_op);
            if (DEBUG_P_TEST_) debprof(PL_op);
        }
+
+        OP_ENTRY_PROBE(OP_NAME(PL_op));
     } while ((PL_op = PL_op->op_ppaddr(aTHX)));
     DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));