This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Remove the -P switch
[perl5.git] / dump.c
diff --git a/dump.c b/dump.c
index 1ad3e77..3e4db86 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -32,11 +32,11 @@ static const char* const svtypenames[SVt_LAST] = {
     "BIND",
     "IV",
     "NV",
-    "RV",
     "PV",
     "PVIV",
     "PVNV",
     "PVMG",
+    "REGEXP",
     "PVGV",
     "PVLV",
     "PVAV",
@@ -52,11 +52,11 @@ static const char* const svshorttypenames[SVt_LAST] = {
     "BIND",
     "IV",
     "NV",
-    "RV",
     "PV",
     "PVIV",
     "PVNV",
     "PVMG",
+    "REGEXP",
     "GV",
     "PVLV",
     "AV",
@@ -219,7 +219,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
     const char * const end = pv + count; /* end of string */
     octbuf[0] = esc;
 
-    if (!flags & PERL_PV_ESCAPE_NOCLEAR) {
+    if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
            /* This won't alter the UTF-8 flag */
            sv_setpvn(dsv, "", 0);
     }
@@ -333,12 +333,15 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
     const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
     STRLEN escaped;
     
+    if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
+           /* This won't alter the UTF-8 flag */
+           sv_setpvn(dsv, "", 0);
+    }
+
     if ( dq == '"' )
-        sv_setpvn(dsv, "\"", 1);
+        sv_catpvn(dsv, "\"", 1);
     else if ( flags & PERL_PV_PRETTY_LTGT )
-        sv_setpvn(dsv, "<", 1);
-    else 
-        sv_setpvn(dsv, "", 0);
+        sv_catpvn(dsv, "<", 1);
         
     if ( start_color != NULL ) 
         Perl_sv_catpv( aTHX_ dsv, start_color);
@@ -541,7 +544,7 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
        ch = '/';
     if (PM_GETRE(pm))
        Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
-            ch, PM_GETRE(pm)->precomp, ch,
+            ch, RX_PRECOMP(PM_GETRE(pm)), ch,
             (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
     else
        Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
@@ -549,7 +552,7 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
        Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
        op_dump(pm->op_pmreplrootu.op_pmreplroot);
     }
-    if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
+    if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
        SV * const tmpsv = pm_description(pm);
        Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
        SvREFCNT_dec(tmpsv);
@@ -576,15 +579,15 @@ S_pm_description(pTHX_ const PMOP *pm)
 #endif
 
     if (regex) {
-        if (regex->extflags & RXf_TAINTED)
+        if (RX_EXTFLAGS(regex) & RXf_TAINTED)
             sv_catpv(desc, ",TAINTED");
-        if (regex->check_substr) {
-            if (!(regex->extflags & RXf_NOSCAN))
+        if (RX_CHECK_SUBSTR(regex)) {
+            if (!(RX_EXTFLAGS(regex) & RXf_NOSCAN))
                 sv_catpv(desc, ",SCANFIRST");
-            if (regex->extflags & RXf_CHECK_ALL)
+            if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
                 sv_catpv(desc, ",ALL");
         }
-        if (regex->extflags & RXf_SKIPWHITE)
+        if (RX_EXTFLAGS(regex) & RXf_SKIPWHITE)
             sv_catpv(desc, ",SKIPWHITE");
     }
 
@@ -1280,16 +1283,17 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
            Perl_dump_indent(aTHX_ level, file, "    MG_OBJ = 0x%"UVxf"\n", 
                PTR2UV(mg->mg_obj));
             if (mg->mg_type == PERL_MAGIC_qr) {
-               const regexp * const re = (regexp *)mg->mg_obj;
+               REGEXP* const re = (REGEXP *)mg->mg_obj;
                SV * const dsv = sv_newmortal();
-                const char * const s =  pv_pretty(dsv, re->wrapped, re->wraplen, 
+                const char * const s
+                   = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re), 
                     60, NULL, NULL,
                     ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
-                    ((re->extflags & RXf_UTF8) ? PERL_PV_ESCAPE_UNI : 0))
+                    (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
                 );
                Perl_dump_indent(aTHX_ level+1, file, "    PAT = %s\n", s);
                Perl_dump_indent(aTHX_ level+1, file, "    REFCNT = %"IVdf"\n",
-                       (IV)re->refcnt);
+                       (IV)RX_REFCNT(re));
             }
             if (mg->mg_flags & MGf_REFCOUNTED)
                do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
@@ -1526,7 +1530,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     }
     if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
         && type != SVt_PVCV && !isGV_with_GP(sv))
-       || type == SVt_IV) {
+       || (type == SVt_IV && !SvROK(sv))) {
        if (SvIsUV(sv)
 #ifdef PERL_OLD_COPY_ON_WRITE
                       || SvIsCOW(sv)
@@ -1535,8 +1539,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            Perl_dump_indent(aTHX_ level, file, "  UV = %"UVuf, (UV)SvUVX(sv));
        else
            Perl_dump_indent(aTHX_ level, file, "  IV = %"IVdf, (IV)SvIVX(sv));
-       if (SvOOK(sv))
-           PerlIO_printf(file, "  (OFFSET)");
 #ifdef PERL_OLD_COPY_ON_WRITE
        if (SvIsCOW_shared_hash(sv))
            PerlIO_printf(file, "  (HASH)");
@@ -1551,8 +1553,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  COP_HIGH = %"UVuf"\n",
                         (UV) COP_SEQ_RANGE_HIGH(sv));
     } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
-               && type != SVt_PVCV && type != SVt_PVFM && !isGV_with_GP(sv)
-               && !SvVALID(sv))
+               && type != SVt_PVCV && type != SVt_PVFM  && type != SVt_REGEXP
+               && !isGV_with_GP(sv) && !SvVALID(sv))
               || type == SVt_NV) {
        STORE_NUMERIC_LOCAL_SET_STANDARD();
        /* %Vg doesn't work? --jhi */
@@ -1574,9 +1576,20 @@ 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)) {
+           STRLEN delta;
+           if (SvOOK(sv)) {
+               SvOOK_offset(sv, delta);
+               Perl_dump_indent(aTHX_ level, file,"  OFFSET = %"UVuf"\n",
+                                (UV) delta);
+           } else {
+               delta = 0;
+           }
            Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
-           if (SvOOK(sv))
-               PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
+           if (SvOOK(sv)) {
+               PerlIO_printf(file, "( %s . ) ",
+                             pv_display(d, SvPVX_const(sv) - delta, delta, 0,
+                                        pvlim));
+           }
            PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), 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));
@@ -1587,6 +1600,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        else
            Perl_dump_indent(aTHX_ level, file, "  PV = 0\n");
     }
+    if (type == SVt_REGEXP) {
+       /* FIXME dumping
+           Perl_dump_indent(aTHX_ level, file, "  REGEXP = 0x%"UVxf"\n",
+                            PTR2UV(((struct regexp *)SvANY(sv))->xrx_regexp));
+       */
+    }
     if (type >= SVt_PVMG) {
        if (type == SVt_PVMG && SvPAD_OUR(sv)) {
            HV * const ost = SvOURSTASH(sv);
@@ -2112,7 +2131,7 @@ Perl_xmldump_sub(pTHX_ const GV *gv)
 {
     SV * const sv = sv_newmortal();
 
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
     if (CvXSUB(GvCV(gv)))
        Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
@@ -2129,7 +2148,7 @@ Perl_xmldump_form(pTHX_ const GV *gv)
 {
     SV * const sv = sv_newmortal();
 
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
     if (CvROOT(GvFORM(gv)))
        op_xmldump(CvROOT(GvFORM(gv)));
@@ -2243,7 +2262,7 @@ Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
            sv_catpvs(dsv, "&amp;");
            break;
        case '"':
-           sv_catpvf(dsv, "&#34;");
+           sv_catpvs(dsv, "&#34;");
            break;
        default:
            if (c < 0xD800) {
@@ -2368,9 +2387,6 @@ Perl_sv_xmlpeek(pTHX_ SV *sv)
     case SVt_NV:
        sv_catpv(t, " NV=\"");
        break;
-    case SVt_RV:
-       sv_catpv(t, " RV=\"");
-       break;
     case SVt_PV:
        sv_catpv(t, " PV=\"");
        break;
@@ -2404,6 +2420,9 @@ Perl_sv_xmlpeek(pTHX_ SV *sv)
     case SVt_BIND:
        sv_catpv(t, " BIND=\"");
        break;
+    case SVt_REGEXP:
+       sv_catpv(t, " ORANGE=\"");
+       break;
     case SVt_PVFM:
        sv_catpv(t, " FM=\"");
        break;
@@ -2448,10 +2467,9 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
     Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
     level++;
     if (PM_GETRE(pm)) {
-       const char * const s = PM_GETRE(pm)->precomp;
-       SV * const tmpsv = newSVpvn("",0);
-       SvUTF8_on(tmpsv);
-       sv_catxmlpvn(tmpsv, s, strlen(s), 1);
+       REGEXP *const r = PM_GETRE(pm);
+       SV * const tmpsv = newSVsv((SV*)r);
+       sv_utf8_upgrade(tmpsv);
        Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
             SvPVX(tmpsv));
        SvREFCNT_dec(tmpsv);
@@ -2460,7 +2478,7 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
     }
     else
        Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
-    if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
+    if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
        SV * const tmpsv = pm_description(pm);
        Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
        SvREFCNT_dec(tmpsv);
@@ -2736,16 +2754,14 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
        S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
 #else
        if (cSVOPo->op_sv) {
-           SV * const tmpsv1 = newSV(0);
-           SV * const tmpsv2 = newSVpvn("",0);
+           SV * const tmpsv1 = newSVpvn_utf8(NULL, 0, TRUE);
+           SV * const tmpsv2 = newSVpvn_utf8("", 0, TRUE);
            char *s;
            STRLEN len;
-           SvUTF8_on(tmpsv1);
-           SvUTF8_on(tmpsv2);
            ENTER;
            SAVEFREESV(tmpsv1);
            SAVEFREESV(tmpsv2);
-           gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, Nullch);
+           gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, NULL);
            s = SvPV(tmpsv1,len);
            sv_catxmlpvn(tmpsv2, s, len, 1);
            S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
@@ -2827,10 +2843,9 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
 
     if (PL_madskills && o->op_madprop) {
        char prevkey = '\0';
-       SV * const tmpsv = newSVpvn("", 0);
+       SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
        const MADPROP* mp = o->op_madprop;
 
-       sv_utf8_upgrade(tmpsv);
        if (!contents) {
            contents = 1;
            PerlIO_printf(file, ">\n");
Unnamed repository; edit this file 'description' to name the repository.