projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
Patch: Put local($^I, @ARGV) = ... trick back into perlfaq5
[p5sagit/p5-mst-13.2.git] / dump.c
diff --git a/dump.c b/dump.c
index 863b006..e287a79 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1,6 +1,6 @@
 /*    dump.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -75,8 +75,8 @@ Perl_dump_sub(pTHX_ GV *gv)
     gv_fullname3(sv, gv, Nullch);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX(sv));
     if (CvXSUB(GvCV(gv)))
-       Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%lx %d)\n",
-           (long)CvXSUB(GvCV(gv)),
+       Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
+           PTR2UV(CvXSUB(GvCV(gv))),
            (int)CvXSUBANY(GvCV(gv)).any_i32);
     else if (CvROOT(GvCV(gv)))
        op_dump(CvROOT(GvCV(gv)));
@@ -279,13 +279,14 @@ Perl_sv_peek(pTHX_ SV *sv)
            Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127));
            if (SvUTF8(sv))
                Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
-                              sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv), 0));
+                              sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv),
+                                             UNI_DISPLAY_QQ));
            SvREFCNT_dec(tmp);
        }
     }
     else if (SvNOKp(sv)) {
        STORE_NUMERIC_LOCAL_SET_STANDARD();
-       Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv));
+       Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
        RESTORE_NUMERIC_LOCAL();
     }
     else if (SvIOKp(sv)) {
@@ -460,8 +461,6 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
         else if (o->op_type == OP_AASSIGN) {
            if (o->op_private & OPpASSIGN_COMMON)
                sv_catpv(tmpsv, ",COMMON");
-           if (o->op_private & OPpASSIGN_HASH)
-               sv_catpv(tmpsv, ",HASH");
        }
        else if (o->op_type == OP_SASSIGN) {
            if (o->op_private & OPpASSIGN_BACKWARDS)
@@ -503,6 +502,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
                    sv_catpv(tmpsv, ",NOPAREN");
                if (o->op_private & OPpENTERSUB_INARGS)
                    sv_catpv(tmpsv, ",INARGS");
+               if (o->op_private & OPpENTERSUB_NOMOD)
+                   sv_catpv(tmpsv, ",NOMOD");
            }
            else {
                switch (o->op_private & OPpDEREF) {
@@ -549,7 +550,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
        else if (o->op_type == OP_FLOP) {
            if (o->op_private & OPpFLIP_LINENUM)
                sv_catpv(tmpsv, ",LINENUM");
-       } else if (o->op_type == OP_RV2CV) {
+       }
+       else if (o->op_type == OP_RV2CV) {
            if (o->op_private & OPpLVAL_INTRO)
                sv_catpv(tmpsv, ",INTRO");
        }
@@ -613,7 +615,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
     case OP_GVSV:
     case OP_GV:
 #ifdef USE_ITHREADS
-       Perl_dump_indent(aTHX_ level, file, "PADIX = %d\n", cPADOPo->op_padix);
+       Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
 #else
        if (cSVOPo->op_sv) {
            SV *tmpsv = NEWSV(0,0);
@@ -727,7 +729,7 @@ Perl_gv_dump(pTHX_ GV *gv)
 }
 
 
-/* map magic types to the symbolic name
+/* map magic types to the symbolic names
  * (with the PERL_MAGIC_ prefixed stripped)
  */
 
@@ -743,6 +745,7 @@ static struct { char type; char *name; } magic_names[] = {
        { PERL_MAGIC_env,            "env(E)" },
        { PERL_MAGIC_isa,            "isa(I)" },
        { PERL_MAGIC_dbfile,         "dbfile(L)" },
+       { PERL_MAGIC_shared,         "shared(N)" },
        { PERL_MAGIC_tied,           "tied(P)" },
        { PERL_MAGIC_sig,            "sig(S)" },
        { PERL_MAGIC_uvar,           "uvar(U)" },
@@ -756,13 +759,16 @@ static struct { char type; char *name; } magic_names[] = {
        { PERL_MAGIC_nkeys,          "nkeys(k)" },
        { PERL_MAGIC_dbline,         "dbline(l)" },
        { PERL_MAGIC_mutex,          "mutex(m)" },
+       { PERL_MAGIC_shared_scalar,  "shared_scalar(n)" },
        { PERL_MAGIC_collxfrm,       "collxfrm(o)" },
        { PERL_MAGIC_tiedelem,       "tiedelem(p)" },
        { PERL_MAGIC_tiedscalar,     "tiedscalar(q)" },
        { PERL_MAGIC_qr,             "qr(r)" },
        { PERL_MAGIC_sigelem,        "sigelem(s)" },
        { PERL_MAGIC_taint,          "taint(t)" },
+       { PERL_MAGIC_uvar_elem,      "uvar_elem(v)" },
        { PERL_MAGIC_vec,            "vec(v)" },
+       { PERL_MAGIC_vstring,        "v-string(V)" },
        { PERL_MAGIC_substr,         "substr(x)" },
        { PERL_MAGIC_defelem,        "defelem(y)" },
        { PERL_MAGIC_ext,            "ext(~)" },
@@ -972,10 +978,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (SvCOMPILED(sv))     sv_catpv(d, "COMPILED,");
        if (CvLVALUE(sv))       sv_catpv(d, "LVALUE,");
        if (CvMETHOD(sv))       sv_catpv(d, "METHOD,");
+       if (CvLOCKED(sv))       sv_catpv(d, "LOCKED,");
        break;
     case SVt_PVHV:
        if (HvSHAREKEYS(sv))    sv_catpv(d, "SHAREKEYS,");
        if (HvLAZYDEL(sv))      sv_catpv(d, "LAZYDEL,");
+       if (HvHASKFLAGS(sv))    sv_catpv(d, "HASKFLAGS,");
        break;
     case SVt_PVGV:
        if (GvINTRO(sv))        sv_catpv(d, "INTRO,");
@@ -1076,12 +1084,22 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        return;
     }
     if (type >= SVt_PVIV || type == SVt_IV) {
-       if (SvIsUV(sv))
+       if (SvIsUV(sv)
+#ifdef PERL_COPY_ON_WRITE
+                      || SvIsCOW(sv)
+#endif
+                                    )
            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_COPY_ON_WRITE
+       if (SvIsCOW_shared_hash(sv))
+           PerlIO_printf(file, "  (HASH)");
+       else if (SvIsCOW_normal(sv))
+           PerlIO_printf(file, "  (COW from 0x%"UVxf")", (UV)SvUVX(sv));
+#endif
        PerlIO_putc(file, '\n');
     }
     if (type >= SVt_PVNV || type == SVt_NV) {
@@ -1112,7 +1130,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
            PerlIO_printf(file, "%s", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
            if (SvUTF8(sv)) /* the 8?  \x{....} */
-               PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), 0));
+               PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(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));
@@ -1176,7 +1194,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 
            PerlIO_printf(file, "  (");
            Zero(freq, FREQ_MAX + 1, int);
-           for (i = 0; i <= HvMAX(sv); i++) {
+           for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
                HE* h; int count = 0;
                 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
                    count++;
@@ -1233,7 +1251,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            int count = maxnest - nest;
 
            hv_iterinit(hv);
-           while ((he = hv_iternext(hv)) && count--) {
+           while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
+                   && count--) {
                SV *elt, *keysv;
                char *keypv;
                STRLEN len;
@@ -1244,7 +1263,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                elt = hv_iterval(hv, he);
                Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
                if (SvUTF8(keysv))
-                   PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), 0));
+                   PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ));
                PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
                do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
            }
@@ -1369,7 +1388,7 @@ Perl_runops_debug(pTHX)
 {
     if (!PL_op) {
        if (ckWARN_d(WARN_DEBUGGING))
-           Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
+           Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
        return 0;
     }
 
@@ -1381,7 +1400,16 @@ Perl_runops_debug(pTHX)
                              "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
                              PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
                              PTR2UV(*PL_watchaddr));
-           if (DEBUG_p_TEST_) debstack();
+           if (DEBUG_s_TEST_) {
+               if (DEBUG_v_TEST_) {
+                   PerlIO_printf(Perl_debug_log, "\n");
+                   deb_stack_all();
+               }
+               else
+                   debstack();
+           }
+
+
            if (DEBUG_t_TEST_) debop(PL_op);
            if (DEBUG_P_TEST_) debprof(PL_op);
        }
@@ -1398,6 +1426,10 @@ Perl_debop(pTHX_ OP *o)
     CV *cv;
     SV *sv;
     STRLEN n_a;
+
+    if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
+       return 0;
+
     Perl_deb(aTHX_ "%s", OP_NAME(o));
     switch (o->op_type) {
     case OP_CONST:
@@ -1465,6 +1497,8 @@ Perl_watch(pTHX_ char **addr)
 STATIC void
 S_debprof(pTHX_ OP *o)
 {
+    if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
+       return;
     if (!PL_profiledata)
        Newz(000, PL_profiledata, MAXO, U32);
     ++PL_profiledata[o->op_type];
Unnamed repository; edit this file to name it for gitweb.