const struct flag_to_name op_flags_names[] = {
{OPf_KIDS, ",KIDS"},
{OPf_PARENS, ",PARENS"},
- {OPf_STACKED, ",STACKED"},
{OPf_REF, ",REF"},
{OPf_MOD, ",MOD"},
+ {OPf_STACKED, ",STACKED"},
{OPf_SPECIAL, ",SPECIAL"}
};
const struct flag_to_name op_trans_names[] = {
+ {OPpTRANS_FROM_UTF, ",FROM_UTF"},
+ {OPpTRANS_TO_UTF, ",TO_UTF"},
+ {OPpTRANS_IDENTICAL, ",IDENTICAL"},
{OPpTRANS_SQUASH, ",SQUASH"},
- {OPpTRANS_DELETE, ",DELETE"},
{OPpTRANS_COMPLEMENT, ",COMPLEMENT"},
- {OPpTRANS_IDENTICAL, ",IDENTICAL"},
- {OPpTRANS_GROWS, ",GROWS"}
+ {OPpTRANS_GROWS, ",GROWS"},
+ {OPpTRANS_DELETE, ",DELETE"}
};
const struct flag_to_name op_entersub_names[] = {
- {OPpENTERSUB_AMPER, ",AMPER"},
{OPpENTERSUB_DB, ",DB"},
{OPpENTERSUB_HASTARG, ",HASTARG"},
+ {OPpENTERSUB_NOMOD, ",NOMOD"},
+ {OPpENTERSUB_AMPER, ",AMPER"},
{OPpENTERSUB_NOPAREN, ",NOPAREN"},
- {OPpENTERSUB_INARGS, ",INARGS"},
- {OPpENTERSUB_NOMOD, ",NOMOD"}
+ {OPpENTERSUB_INARGS, ",INARGS"}
};
const struct flag_to_name op_const_names[] = {
- {OPpCONST_BARE, ",BARE"},
+ {OPpCONST_NOVER, ",NOVER"},
+ {OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
{OPpCONST_STRICT, ",STRICT"},
+ {OPpCONST_ENTERED, ",ENTERED"},
{OPpCONST_ARYBASE, ",ARYBASE"},
- {OPpCONST_WARNING, ",WARNING"},
- {OPpCONST_ENTERED, ",ENTERED"}
+ {OPpCONST_BARE, ",BARE"},
+ {OPpCONST_WARNING, ",WARNING"}
};
const struct flag_to_name op_sort_names[] = {
{OPpSORT_NUMERIC, ",NUMERIC"},
{OPpSORT_INTEGER, ",INTEGER"},
- {OPpSORT_REVERSE, ",REVERSE"}
+ {OPpSORT_REVERSE, ",REVERSE"},
+ {OPpSORT_INPLACE, ",INPLACE"},
+ {OPpSORT_DESCEND, ",DESCEND"},
+ {OPpSORT_QSORT, ",QSORT"},
+ {OPpSORT_STABLE, ",STABLE"}
};
const struct flag_to_name op_open_names[] = {
OP_PRIVATE_ONCE(op_leavesub, OPpREFCOUNTED, ",REFCOUNTED");
OP_PRIVATE_ONCE(op_sassign, OPpASSIGN_BACKWARDS, ",BACKWARDS");
OP_PRIVATE_ONCE(op_repeat, OPpREPEAT_DOLIST, ",DOLIST");
+OP_PRIVATE_ONCE(op_reverse, OPpREVERSE_INPLACE, ",INPLACE");
OP_PRIVATE_ONCE(op_rv2cv, OPpLVAL_INTRO, ",INTRO");
OP_PRIVATE_ONCE(op_flip, OPpFLIP_LINENUM, ",LINENUM");
OP_PRIVATE_ONCE(op_gv, OPpEARLY_CV, ",EARLY_CV");
}
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_NODEBUG, "NODEBUG,"},
{CVf_LVALUE, "LVALUE,"},
{CVf_METHOD, "METHOD,"},
- {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"}
+ {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
+ {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
do_hv_dump(level, file, " OURSTASH", ost);
} else {
if (SvMAGIC(sv))
- do_magic_dump(level, file, SvMAGIC(sv), nest, maxnest, dumpops, pvlim);
+ do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
}
if (SvSTASH(sv))
do_hv_dump(level, file, " STASH", SvSTASH(sv));
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 (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
- HE *he;
- HV * const hv = MUTABLE_HV(sv);
- int count = maxnest - nest;
-
- hv_iterinit(hv);
- while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
- && count--) {
- STRLEN len;
- const U32 hash = HeHASH(he);
- SV * const keysv = hv_iterkeysv(he);
- const char * const keypv = SvPV_const(keysv, len);
- SV * const 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, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
- if (HeKREHASH(he))
- PerlIO_printf(file, "[REHASH] ");
- PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
- do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
+ if (nest < maxnest) {
+ if (HvEITER_get(sv)) /* preserve iterator */
+ Perl_dump_indent(aTHX_ level, file,
+ " (*** Active iterator; skipping element dump ***)\n");
+ else {
+ HE *he;
+ HV * const hv = MUTABLE_HV(sv);
+ int count = maxnest - nest;
+
+ hv_iterinit(hv);
+ while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
+ && count--) {
+ STRLEN len;
+ const U32 hash = HeHASH(he);
+ SV * const keysv = hv_iterkeysv(he);
+ const char * const keypv = SvPV_const(keysv, len);
+ SV * const 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, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
+ if (HeKREHASH(he))
+ PerlIO_printf(file, "[REHASH] ");
+ PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
+ do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
+ }
+ hv_iterinit(hv); /* Return to status quo */
}
- hv_iterinit(hv); /* Return to status quo */
}
break;
case SVt_PVCV:
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