chsize = 2;
switch (c) {
- case '\\' : /* fallthrough */
+ case '\\' : /* FALLTHROUGH */
case '%' : if ( c == esc ) {
octbuf[1] = esc;
} else {
if (type == SVt_PVCV) {
SV * const tmp = newSVpvs_flags("", SVs_TEMP);
GV* gvcv = CvGV(sv);
- Perl_sv_catpvf(aTHX_ t, "CV(\"%s\")", gvcv
+ Perl_sv_catpvf(aTHX_ t, "CV(%s)", gvcv
? generic_pv_escape( tmp, GvNAME(gvcv), GvNAMELEN(gvcv), GvNAMEUTF8(gvcv))
: "");
goto finish;
finish:
while (unref--)
sv_catpv(t, ")");
- if (TAINTING_get && SvTAINTED(sv))
+ if (TAINTING_get && sv && SvTAINTED(sv))
sv_catpv(t, " [tainted]");
return SvPV_nolen(t);
}
if (RX_ISTAINTED(regex))
sv_catpv(desc, ",TAINTED");
if (RX_CHECK_SUBSTR(regex)) {
- if (!(RX_EXTFLAGS(regex) & RXf_NOSCAN))
+ if (!(RX_INTFLAGS(regex) & PREGf_NOSCAN))
sv_catpv(desc, ",SCANFIRST");
if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
sv_catpv(desc, ",ALL");
static bool
S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
const struct op_private_by_op *start = op_private_names;
- const struct op_private_by_op *const end
- = op_private_names + C_ARRAY_LENGTH(op_private_names);
+ const struct op_private_by_op *const end = C_ARRAY_END(op_private_names);
/* This is a linear search, but no worse than the code that it replaced.
It's debugging code - size is more important than speed. */
{GVf_IMPORTED_CV, " CV"},
};
-const struct flag_to_name regexp_flags_names[] = {
+/* NOTE: this structure is mostly duplicative of one generated by
+ * 'make regen' in regnodes.h - perhaps we should somehow integrate
+ * the two. - Yves */
+const struct flag_to_name regexp_extflags_names[] = {
{RXf_PMf_MULTILINE, "PMf_MULTILINE,"},
{RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
{RXf_PMf_FOLD, "PMf_FOLD,"},
{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
- {RXf_ANCH_BOL, "ANCH_BOL,"},
- {RXf_ANCH_MBOL, "ANCH_MBOL,"},
- {RXf_ANCH_SBOL, "ANCH_SBOL,"},
- {RXf_ANCH_GPOS, "ANCH_GPOS,"},
- {RXf_GPOS_SEEN, "GPOS_SEEN,"},
- {RXf_GPOS_FLOAT, "GPOS_FLOAT,"},
+ {RXf_IS_ANCHORED, "IS_ANCHORED,"},
{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
{RXf_EVAL_SEEN, "EVAL_SEEN,"},
- {RXf_CANY_SEEN, "CANY_SEEN,"},
- {RXf_NOSCAN, "NOSCAN,"},
{RXf_CHECK_ALL, "CHECK_ALL,"},
{RXf_MATCH_UTF8, "MATCH_UTF8,"},
{RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
{RXf_NULL, "NULL,"},
};
+/* NOTE: this structure is mostly duplicative of one generated by
+ * 'make regen' in regnodes.h - perhaps we should somehow integrate
+ * the two. - Yves */
+const struct flag_to_name regexp_core_intflags_names[] = {
+ {PREGf_SKIP, "SKIP,"},
+ {PREGf_IMPLICIT, "IMPLICIT,"},
+ {PREGf_NAUGHTY, "NAUGHTY,"},
+ {PREGf_VERBARG_SEEN, "VERBARG_SEEN,"},
+ {PREGf_CUTGROUP_SEEN, "CUTGROUP_SEEN,"},
+ {PREGf_USE_RE_EVAL, "USE_RE_EVAL,"},
+ {PREGf_NOSCAN, "NOSCAN,"},
+ {PREGf_CANY_SEEN, "CANY_SEEN,"},
+ {PREGf_GPOS_SEEN, "GPOS_SEEN,"},
+ {PREGf_GPOS_FLOAT, "GPOS_FLOAT,"},
+ {PREGf_ANCH_BOL, "ANCH_BOL,"},
+ {PREGf_ANCH_MBOL, "ANCH_MBOL,"},
+ {PREGf_ANCH_SBOL, "ANCH_SBOL,"},
+ {PREGf_ANCH_GPOS, "ANCH_GPOS,"},
+};
+
void
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
{
sv_catpv(d, " ),");
}
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
default:
evaled_or_uv:
if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
if (SvVALID(sv)) sv_catpv(d, "VALID,");
if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case SVt_PVNV:
if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
goto evaled_or_uv;
if (AvREIFY(sv)) sv_catpv(d, ",REIFY");
Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n",
SvCUR(d) ? SvPVX_const(d) + 1 : "");
- if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) {
+ if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
SSize_t count;
- for (count = 0; count <= av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
+ for (count = 0; count <= av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
}
}
break;
- case SVt_PVHV:
+ case SVt_PVHV: {
+ U32 usedkeys;
+ if (SvOOK(sv)) {
+ struct xpvhv_aux *const aux = HvAUX(sv);
+ Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %"UVuf"\n",
+ (UV)aux->xhv_aux_flags);
+ }
Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv)));
- if (HvARRAY(sv) && HvUSEDKEYS(sv)) {
+ usedkeys = HvUSEDKEYS(sv);
+ if (HvARRAY(sv) && usedkeys) {
/* Show distribution of HEs in the ARRAY */
int freq[200];
-#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
+#define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1))
int i;
int max = 0;
- U32 pow2 = 2, keys = HvUSEDKEYS(sv);
+ U32 pow2 = 2, keys = usedkeys;
NV theoret, sum = 0;
PerlIO_printf(file, " (");
}
while ((keys = keys >> 1))
pow2 = pow2 << 1;
- theoret = HvUSEDKEYS(sv);
+ theoret = usedkeys;
theoret += theoret * (theoret-1)/pow2;
PerlIO_putc(file, '\n');
Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100);
}
PerlIO_putc(file, '\n');
- Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv));
+ Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)usedkeys);
{
STRLEN count = 0;
HE **ents = HvARRAY(sv);
}
}
break;
+ } /* case SVt_PVHV */
case SVt_PVCV:
if (CvAUTOLOAD(sv)) {
generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv),
SvUTF8(sv)));
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case SVt_PVFM:
do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
if (!CvISXSUB(sv)) {
: CvANON(outside) ? "ANON"
: (outside == PL_main_cv) ? "MAIN"
: CvUNIQUE(outside) ? "UNIQUE"
- : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
+ : CvGV(outside) ?
+ generic_pv_escape(
+ newSVpvs_flags("", SVs_TEMP),
+ GvNAME(CvGV(outside)),
+ GvNAMELEN(CvGV(outside)),
+ GvNAMEUTF8(CvGV(outside)))
+ : "UNDEFINED"));
}
if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
dumpregexp:
{
struct regexp * const r = ReANY((REGEXP*)sv);
-#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags) STMT_START { \
+
+#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
sv_setpv(d,""); \
- append_flags(d, flags, regexp_flags_names); \
+ append_flags(d, flags, names); \
if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') { \
SvCUR_set(d, SvCUR(d) - 1); \
SvPVX(d)[SvCUR(d)] = '\0'; \
} \
} STMT_END
- SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags);
+ SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
Perl_dump_indent(aTHX_ level, file, " COMPFLAGS = 0x%"UVxf" (%s)\n",
(UV)(r->compflags), SvPVX_const(d));
- SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags);
+ SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%"UVxf" (%s)\n",
(UV)(r->extflags), SvPVX_const(d));
-#undef SV_SET_STRINGIFY_REGEXP_FLAGS
- Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
+ Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf" (%s)\n",
+ PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
+ if (r->engine == &PL_core_reg_engine) {
+ SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
+ Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf" (%s)\n",
+ (UV)(r->intflags), SvPVX_const(d));
+ } else {
+ Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%"UVxf"\n",
(UV)(r->intflags));
+ }
+#undef SV_SET_STRINGIFY_REGEXP_FLAGS
Perl_dump_indent(aTHX_ level, file, " NPARENS = %"UVuf"\n",
(UV)(r->nparens));
Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %"UVuf"\n",
pv_display(d, r->subbeg, r->sublen, 50, pvlim));
else
Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n");
- Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%"UVxf"\n",
- PTR2UV(r->engine));
Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
PTR2UV(r->mother_re));
if (nest < maxnest && r->mother_re)
https://perl5.git.perl.org / perl5.git / blobdiff