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;
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 */
}
}
}
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)))
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) {
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
{
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;
}
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;
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;
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 */
}
}
}
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)))