Nits in perlre.pod, x-referencing, broken links

[perl5.git] / dump.c

diff --git a/dump.c b/dump.c
index e7f5a1d..83ced6a 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -92,20 +92,34 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 void
 Perl_dump_all(pTHX)
 {
+    dump_all_perl(FALSE);
+}
+
+void
+Perl_dump_all_perl(pTHX_ bool justperl)
+{
+
     dVAR;
     PerlIO_setlinebuf(Perl_debug_log);
     if (PL_main_root)
        op_dump(PL_main_root);
-    dump_packsubs(PL_defstash);
+    dump_packsubs_perl(PL_defstash, justperl);
 }
 
 void
 Perl_dump_packsubs(pTHX_ const HV *stash)
 {
+    PERL_ARGS_ASSERT_DUMP_PACKSUBS;
+    dump_packsubs_perl(stash, FALSE);
+}
+
+void
+Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
+{
     dVAR;
     I32        i;
 
-    PERL_ARGS_ASSERT_DUMP_PACKSUBS;
+    PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
 
     if (!HvARRAY(stash))
        return;
@@ -116,13 +130,13 @@ Perl_dump_packsubs(pTHX_ const HV *stash)
            if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
                continue;
            if (GvCVu(gv))
-               dump_sub(gv);
+               dump_sub_perl(gv, justperl);
            if (GvFORM(gv))
                dump_form(gv);
            if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
                const HV * const hv = GvHV(gv);
                if (hv && (hv != PL_defstash))
-                   dump_packsubs(hv);          /* nested package */
+                   dump_packsubs_perl(hv, justperl); /* nested package */
            }
        }
     }
@@ -131,10 +145,21 @@ Perl_dump_packsubs(pTHX_ const HV *stash)
 void
 Perl_dump_sub(pTHX_ const GV *gv)
 {
-    SV * const sv = sv_newmortal();
-
     PERL_ARGS_ASSERT_DUMP_SUB;
+    dump_sub_perl(gv, FALSE);
+}
+
+void
+Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
+{
+    SV * sv;
+
+    PERL_ARGS_ASSERT_DUMP_SUB_PERL;
 
+    if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
+       return;
+
+    sv = sv_newmortal();
     gv_fullname3(sv, gv, NULL);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
     if (CvISXSUB(GvCV(gv)))
@@ -1261,6 +1286,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
            else if (v == &PL_vtbl_utf8)       s = "utf8";
             else if (v == &PL_vtbl_arylen_p)   s = "arylen_p";
             else if (v == &PL_vtbl_hintselem)  s = "hintselem";
+            else if (v == &PL_vtbl_hints)      s = "hints";
            else                               s = NULL;
            if (s)
                Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = &PL_vtbl_%s\n", s);
@@ -1339,8 +1365,13 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
                           maxnest, dumpops, pvlim); /* MG is already +1 */
                continue;
            }
+           else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
            else
-               PerlIO_puts(file, " ???? - please notify IZ");
+               PerlIO_puts(
+                 file,
+                " ???? - " __FILE__
+                " does not know how to handle this MG_LEN"
+               );
             PerlIO_putc(file, '\n');
         }
        if (mg->mg_type == PERL_MAGIC_utf8) {
@@ -1540,12 +1571,15 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     s = SvPVX_const(d);
 
 #ifdef DEBUG_LEAKING_SCALARS
-    Perl_dump_indent(aTHX_ level, file, "ALLOCATED at %s:%d %s %s%s\n",
+    Perl_dump_indent(aTHX_ level, file,
+       "ALLOCATED at %s:%d %s %s%s; serial %"UVuf"\n",
        sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
        sv->sv_debug_line,
        sv->sv_debug_inpad ? "for" : "by",
        sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
-       sv->sv_debug_cloned ? " (cloned)" : "");
+       sv->sv_debug_cloned ? " (cloned)" : "",
+       sv->sv_debug_serial
+    );
 #endif
     Perl_dump_indent(aTHX_ level, file, "SV = ");
     if (type < SVt_LAST) {
@@ -1561,7 +1595,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        return;
     }
     if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
-        && type != SVt_PVCV && !isGV_with_GP(sv) && type != SVt_PVFM)
+        && type != SVt_PVCV && !isGV_with_GP(sv) && type != SVt_PVFM
+        && type != SVt_PVIO)
        || (type == SVt_IV && !SvROK(sv))) {
        if (SvIsUV(sv)
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -1990,14 +2025,12 @@ Perl_runops_debug(pTHX)
 {
     dVAR;
     if (!PL_op) {
-       if (ckWARN_d(WARN_DEBUGGING))
-           Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
+       Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
        return 0;
     }
 
     DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
     do {
-       PERL_ASYNC_CHECK();
        if (PL_debug) {
            if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
                PerlIO_printf(Perl_debug_log,
@@ -2189,9 +2222,16 @@ Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *ar
 void
 Perl_xmldump_all(pTHX)
 {
+    xmldump_all_perl(FALSE);
+}
+
+void
+Perl_xmldump_all_perl(pTHX_ bool justperl)
+{
     PerlIO_setlinebuf(PL_xmlfp);
     if (PL_main_root)
        op_xmldump(PL_main_root);
+    xmldump_packsubs_perl(PL_defstash, justperl);
     if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
        PerlIO_close(PL_xmlfp);
     PL_xmlfp = 0;
@@ -2200,10 +2240,17 @@ Perl_xmldump_all(pTHX)
 void
 Perl_xmldump_packsubs(pTHX_ const HV *stash)
 {
+    PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
+    xmldump_packsubs_perl(stash, FALSE);
+}
+
+void
+Perl_xmldump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
+{
     I32        i;
     HE *entry;
 
-    PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
+    PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL;
 
     if (!HvARRAY(stash))
        return;
@@ -2214,12 +2261,12 @@ Perl_xmldump_packsubs(pTHX_ const HV *stash)
            if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
                continue;
            if (GvCVu(gv))
-               xmldump_sub(gv);
+               xmldump_sub_perl(gv, justperl);
            if (GvFORM(gv))
                xmldump_form(gv);
            if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
                && (hv = GvHV(gv)) && hv != PL_defstash)
-               xmldump_packsubs(hv);           /* nested package */
+               xmldump_packsubs_perl(hv, justperl);    /* nested package */
        }
     }
 }
@@ -2227,10 +2274,21 @@ Perl_xmldump_packsubs(pTHX_ const HV *stash)
 void
 Perl_xmldump_sub(pTHX_ const GV *gv)
 {
-    SV * const sv = sv_newmortal();
-
     PERL_ARGS_ASSERT_XMLDUMP_SUB;
+    xmldump_sub_perl(gv, FALSE);
+}
+
+void
+Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
+{
+    SV * sv;
+
+    PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL;
 
+    if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
+       return;
+
+    sv = sv_newmortal();
     gv_fullname3(sv, gv, NULL);
     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
     if (CvXSUB(GvCV(gv)))