}
else if (S_op_private_to_names(aTHX_ tmpsv, optype, o->op_private)) {
}
- else if (PL_check[optype] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
+ else if (PL_check[optype] != Perl_ck_ftst) {
if (OP_IS_FILETEST_ACCESS(o->op_type) && o->op_private & OPpFT_ACCESS)
sv_catpv(tmpsv, ",FT_ACCESS");
if (o->op_private & OPpFT_STACKED)
{ PERL_MAGIC_tied, "tied(P)" },
{ PERL_MAGIC_sig, "sig(S)" },
{ PERL_MAGIC_uvar, "uvar(U)" },
+ { PERL_MAGIC_checkcall, "checkcall(])" },
{ PERL_MAGIC_overload_elem, "overload_elem(a)" },
{ PERL_MAGIC_overload_table, "overload_table(c)" },
{ PERL_MAGIC_regdatum, "regdatum(d)" },
if (mg->mg_type == PERL_MAGIC_envelem &&
mg->mg_flags & MGf_TAINTEDDIR)
Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
+ if (mg->mg_type == PERL_MAGIC_regex_global &&
+ mg->mg_flags & MGf_MINMATCH)
+ Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
if (mg->mg_flags & MGf_REFCOUNTED)
Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
if (mg->mg_flags & MGf_GSKIP)
Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
- if (mg->mg_type == PERL_MAGIC_regex_global &&
- mg->mg_flags & MGf_MINMATCH)
- Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
+ if (mg->mg_flags & MGf_COPY)
+ Perl_dump_indent(aTHX_ level, file, " COPY\n");
+ if (mg->mg_flags & MGf_DUP)
+ Perl_dump_indent(aTHX_ level, file, " DUP\n");
+ if (mg->mg_flags & MGf_LOCAL)
+ Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
}
if (mg->mg_obj) {
- Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
+ Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
PTR2UV(mg->mg_obj));
if (mg->mg_type == PERL_MAGIC_qr) {
REGEXP* const re = (REGEXP *)mg->mg_obj;
SV * const dsv = sv_newmortal();
const char * const s
- = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
+ = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
60, NULL, NULL,
( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES |
(RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0))
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && (hvname = HvNAME_get(sv)))
- PerlIO_printf(file, "\t\"%s\"\n", hvname);
+ {
+ /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
+ name which quite legally could contain insane things like tabs, newlines, nulls or
+ other scary crap - this should produce sane results - except maybe for unicode package
+ names - but we will wait for someone to file a bug on that - demerphq */
+ SV * const tmpsv = newSVpvs("");
+ PerlIO_printf(file, "\t%s\n", pv_display(tmpsv, hvname, HvNAMELEN_get(sv), 0, 1024));
+ }
else
PerlIO_putc(file, '\n');
}
{CVf_LVALUE, "LVALUE,"},
{CVf_METHOD, "METHOD,"},
{CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
- {CVf_CVGV_RC, "CVGV_RC,"}
+ {CVf_CVGV_RC, "CVGV_RC,"},
+ {CVf_ISXSUB, "ISXSUB,"}
};
const struct flag_to_name hv_flags_names[] = {
#ifdef DEBUG_LEAKING_SCALARS
Perl_dump_indent(aTHX_ level, file,
- "ALLOCATED at %s:%d %s %s%s; serial %"UVuf"\n",
+ "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); 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)" : "",
+ PTR2UV(sv->sv_debug_parent),
sv->sv_debug_serial
);
#endif
AV * const backrefs
= *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
+ if (HvAUX(sv)->xhv_name_count)
+ Perl_dump_indent(aTHX_
+ level, file, " NAMECOUNT = %"IVdf"\n",
+ (IV)HvAUX(sv)->xhv_name_count
+ );
+ if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
+ const I32 count = HvAUX(sv)->xhv_name_count;
+ if (count) {
+ SV * const names = newSVpvs_flags("", SVs_TEMP);
+ /* The starting point is the first element if count is
+ positive and the second element if count is negative. */
+ HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names
+ + (count < 0 ? 1 : 0);
+ HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
+ + (count < 0 ? -count : count);
+ while (hekp < endp) {
+ if (*hekp) {
+ sv_catpvs(names, ", \"");
+ sv_catpvn(names, HEK_KEY(*hekp), HEK_LEN(*hekp));
+ sv_catpvs(names, "\"");
+ } else {
+ /* This should never happen. */
+ sv_catpvs(names, ", (null)");
+ }
+ ++hekp;
+ }
+ Perl_dump_indent(aTHX_
+ level, file, " ENAME = %s\n", SvPV_nolen(names)+2
+ );
+ }
+ else
+ Perl_dump_indent(aTHX_
+ level, file, " ENAME = \"%s\"\n", HvENAME_get(sv)
+ );
+ }
if (backrefs) {
Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
PTR2UV(backrefs));
if (DEBUG_t_TEST_) debop(PL_op);
if (DEBUG_P_TEST_) debprof(PL_op);
}
- } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
+ } while ((PL_op = PL_op->op_ppaddr(aTHX)));
DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
TAINT_NOT;
}
char *
+Perl_sv_catxmlpv(pTHX_ SV *dsv, const char *pv, int utf8)
+{
+ PERL_ARGS_ASSERT_SV_CATXMLPV;
+ return sv_catxmlpvn(dsv, pv, strlen(pv), utf8);
+}
+
+char *
Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
{
unsigned int c;
if (o->op_private & OPpHUSH_VMSISH)
sv_catpv(tmpsv, ",HUSH_VMSISH");
}
- else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
+ else if (PL_check[o->op_type] != Perl_ck_ftst) {
if (OP_IS_FILETEST_ACCESS(o->op_type) && o->op_private & OPpFT_ACCESS)
sv_catpv(tmpsv, ",FT_ACCESS");
if (o->op_private & OPpFT_STACKED)
https://perl5.git.perl.org / perl5.git / blobdiff