for (i = 0; i <= (I32) HvMAX(stash); i++) {
const HE *entry;
for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
- const GV *gv = (GV*)HeVAL(entry);
- const HV *hv;
+ const GV * const gv = (GV*)HeVAL(entry);
if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
continue;
if (GvCVu(gv))
dump_sub(gv);
if (GvFORM(gv))
dump_form(gv);
- if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
- && (hv = GvHV(gv)) && hv != PL_defstash)
- dump_packsubs(hv); /* nested package */
+ if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
+ const HV * const hv = GvHV(gv);
+ if (hv && (hv != PL_defstash))
+ dump_packsubs(hv); /* nested package */
+ }
}
}
}
Normally the SV will be cleared before the escaped string is prepared,
but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
-If PERL_PV_ESCAPE_UNI is set then the input string is treated as unicode,
+If PERL_PV_ESCAPE_UNI is set then the input string is treated as Unicode,
if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
-using C<is_utf8_string()> to determine if it is unicode.
+using C<is_utf8_string()> to determine if it is Unicode.
If PERL_PV_ESCAPE_ALL is set then all input chars will be output
using C<\x01F1> style escapes, otherwise only chars above 255 will be
const STRLEN count, const STRLEN max,
STRLEN * const escaped, const U32 flags )
{
- char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
- char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
+ const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
+ const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
STRLEN wrote = 0; /* chars written so far */
STRLEN chsize = 0; /* size of data to be written */
STRLEN readsize = 1; /* size of data just read */
- bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this unicode */
+ bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this Unicode */
const char *pv = str;
- const char *end = pv + count; /* end of string */
+ const char * const end = pv + count; /* end of string */
octbuf[0] = esc;
if (!flags & PERL_PV_ESCAPE_NOCLEAR)
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags )
{
- U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
+ const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if ( dq == '"' )
Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
if (SvUTF8(sv))
Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
- sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv),
+ sv_uni_display(tmp, sv, 6 * SvCUR(sv),
UNI_DISPLAY_QQ));
SvREFCNT_dec(tmp);
}
sv_catpv(t, "()");
finish:
- if (unref) {
- while (unref--)
- sv_catpv(t, ")");
- }
+ while (unref--)
+ sv_catpv(t, ")");
return SvPV_nolen(t);
}
(pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
else
Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
- if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
+ if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
- op_dump(pm->op_pmreplroot);
+ op_dump(pm->op_pmreplrootu.op_pmreplroot);
}
if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
SV * const tmpsv = pm_description(pm);
S_pm_description(pTHX_ const PMOP *pm)
{
SV * const desc = newSVpvs("");
- const REGEXP * regex = PM_GETRE(pm);
+ const REGEXP * const regex = PM_GETRE(pm);
const U32 pmflags = pm->op_pmflags;
- if (pm->op_pmdynflags & PMdf_USED)
- sv_catpv(desc, ",USED");
- if (pm->op_pmdynflags & PMdf_TAINTED)
- sv_catpv(desc, ",TAINTED");
-
if (pmflags & PMf_ONCE)
sv_catpv(desc, ",ONCE");
- if (regex && regex->check_substr) {
- if (!(regex->extflags & RXf_NOSCAN))
- sv_catpv(desc, ",SCANFIRST");
- if (regex->extflags & RXf_CHECK_ALL)
- sv_catpv(desc, ",ALL");
- }
- if (pmflags & PMf_SKIPWHITE)
- sv_catpv(desc, ",SKIPWHITE");
+#ifdef USE_ITHREADS
+ if (SvREADONLY(PL_regex_pad[pm->op_pmoffset]))
+ sv_catpv(desc, ":USED");
+#else
+ if (pmflags & PMf_USED)
+ sv_catpv(desc, ":USED");
+#endif
+
+ if (regex) {
+ if (regex->extflags & RXf_TAINTED)
+ sv_catpv(desc, ",TAINTED");
+ if (regex->check_substr) {
+ if (!(regex->extflags & RXf_NOSCAN))
+ sv_catpv(desc, ",SCANFIRST");
+ if (regex->extflags & RXf_CHECK_ALL)
+ sv_catpv(desc, ",ALL");
+ }
+ if (regex->extflags & RXf_SKIPWHITE)
+ sv_catpv(desc, ",SKIPWHITE");
+ }
+
if (pmflags & PMf_CONST)
sv_catpv(desc, ",CONST");
if (pmflags & PMf_KEEP)
sequence_tail(cLOOPo->op_lastop);
break;
- case OP_QR:
- case OP_MATCH:
case OP_SUBST:
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
- sequence_tail(cPMOPo->op_pmreplstart);
+ sequence_tail(cPMOPo->op_pmstashstartu.op_pmreplstart);
break;
+ case OP_QR:
+ case OP_MATCH:
case OP_HELEM:
break;
Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
level++;
while (mp) {
- char tmp = mp->mad_key;
+ const char tmp = mp->mad_key;
sv_setpvn(tmpsv,"'",1);
if (tmp)
sv_catpvn(tmpsv, &tmp, 1);
ENTER;
SAVEFREESV(tmpsv);
#ifdef PERL_MAD
- /* FIXME - it this making unwarranted assumptions about the
+ /* FIXME - is this making unwarranted assumptions about the
UTF-8 cleanliness of the dump file handle? */
SvUTF8_on(tmpsv);
#endif
{ PERL_MAGIC_isaelem, "isaelem(i)" },
{ PERL_MAGIC_nkeys, "nkeys(k)" },
{ PERL_MAGIC_dbline, "dbline(l)" },
- { PERL_MAGIC_mutex, "mutex(m)" },
{ PERL_MAGIC_shared_scalar, "shared_scalar(n)" },
{ PERL_MAGIC_collxfrm, "collxfrm(o)" },
{ PERL_MAGIC_tiedelem, "tiedelem(p)" },
Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
}
if (mg->mg_obj) {
- Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
- if (mg->mg_flags & MGf_REFCOUNTED)
+ Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
+ PTR2UV(mg->mg_obj));
+ if (mg->mg_type == PERL_MAGIC_qr) {
+ const regexp * const re = (regexp *)mg->mg_obj;
+ SV * const dsv = sv_newmortal();
+ const char * const s = pv_pretty(dsv, re->wrapped, re->wraplen,
+ 60, NULL, NULL,
+ ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELIPSES |
+ ((re->extflags & RXf_UTF8) ? PERL_PV_ESCAPE_UNI : 0))
+ );
+ Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
+ Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
+ (IV)re->refcnt);
+ }
+ if (mg->mg_flags & MGf_REFCOUNTED)
do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
}
if (mg->mg_len)
Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
if (mg->mg_len >= 0) {
if (mg->mg_type != PERL_MAGIC_utf8) {
- SV *sv = newSVpvs("");
+ SV * const sv = newSVpvs("");
PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
SvREFCNT_dec(sv);
}
PerlIO_putc(file, '\n');
}
if (mg->mg_type == PERL_MAGIC_utf8) {
- STRLEN *cache = (STRLEN *) mg->mg_ptr;
+ const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
if (cache) {
IV i;
for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
if (CvMETHOD(sv)) sv_catpv(d, "METHOD,");
if (CvLOCKED(sv)) sv_catpv(d, "LOCKED,");
if (CvWEAKOUTSIDE(sv)) sv_catpv(d, "WEAKOUTSIDE,");
- if (CvASSERTION(sv)) sv_catpv(d, "ASSERTION,");
break;
case SVt_PVHV:
if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,");
if (SvOOK(sv))
PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
- if (SvUTF8(sv)) /* the 8? \x{....} */
- PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ));
+ if (SvUTF8(sv)) /* the 6? \x{....} */
+ PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
PerlIO_printf(file, "\n");
Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv));
}
if (type >= SVt_PVMG) {
if (type == SVt_PVMG && SvPAD_OUR(sv)) {
- HV *ost = SvOURSTASH(sv);
+ HV * const ost = SvOURSTASH(sv);
if (ost)
do_hv_dump(level, file, " OURSTASH", ost);
} else {
if (nest < maxnest && av_len((AV*)sv) >= 0) {
int count;
for (count = 0; count <= av_len((AV*)sv) && count < maxnest; count++) {
- SV** elt = av_fetch((AV*)sv,count,0);
+ SV** const elt = av_fetch((AV*)sv,count,0);
Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
if (elt)
hv_iterinit(hv);
while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
&& count--) {
- SV *elt, *keysv;
- const char *keypv;
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);
- keysv = hv_iterkeysv(he);
- keypv = SvPV_const(keysv, len);
- 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, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ));
+ 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_op_dump(level+1, file, CvROOT(sv));
}
} else {
- SV *constant = cv_const_sv((CV *)sv);
+ SV * const constant = cv_const_sv((CV *)sv);
Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
if (cGVOPo_gv) {
SV * const sv = newSV(0);
#ifdef PERL_MAD
- /* FIXME - it this making unwarranted assumptions about the
+ /* FIXME - is this making unwarranted assumptions about the
UTF-8 cleanliness of the dump file handle? */
SvUTF8_on(sv);
#endif
}
STATIC CV*
-S_deb_curcv(pTHX_ I32 ix)
+S_deb_curcv(pTHX_ const I32 ix)
{
dVAR;
const PERL_CONTEXT * const cx = &cxstack[ix];
S_debprof(pTHX_ const OP *o)
{
dVAR;
- if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
+ if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
return;
if (!PL_profiledata)
Newxz(PL_profiledata, MAXO, U32);
* XML variants of most of the above routines
*/
-STATIC
-void
+STATIC void
S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
va_list args;
void
Perl_xmldump_sub(pTHX_ const GV *gv)
{
- SV *sv = sv_newmortal();
+ SV * const sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
void
Perl_xmldump_form(pTHX_ const GV *gv)
{
- SV *sv = sv_newmortal();
+ SV * const sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
}
char *
-Perl_sv_catxmlpvn(pTHX_ SV *dsv, char* pv, STRLEN len, int utf8)
+Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
{
unsigned int c;
- char *e = pv + len;
- char *start = pv;
+ const char * const e = pv + len;
+ const char * const start = pv;
STRLEN dsvcur;
STRLEN cl;
char *
Perl_sv_xmlpeek(pTHX_ SV *sv)
{
- SV *t = sv_newmortal();
+ SV * const t = sv_newmortal();
STRLEN n_a;
int unref = 0;
sv_catpv(t, "\"");
finish:
- if (unref) {
- while (unref--)
- sv_catpv(t, ")");
- }
+ while (unref--)
+ sv_catpv(t, ")");
return SvPV(t, n_a);
}
Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
level++;
if (PM_GETRE(pm)) {
- char *s = PM_GETRE(pm)->precomp;
- SV *tmpsv = newSVpvn("",0);
+ const char * const s = PM_GETRE(pm)->precomp;
+ SV * const tmpsv = newSVpvn("",0);
SvUTF8_on(tmpsv);
sv_catxmlpvn(tmpsv, s, strlen(s), 1);
Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
}
level--;
- if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
+ if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
Perl_xmldump_indent(aTHX_ level, file, ">\n");
Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
- do_op_xmldump(level+2, file, pm->op_pmreplroot);
+ do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
}
PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
#endif
if (o->op_flags) {
- SV *tmpsv = newSVpvn("", 0);
+ SV * const tmpsv = newSVpvn("", 0);
switch (o->op_flags & OPf_WANT) {
case OPf_WANT_VOID:
sv_catpv(tmpsv, ",VOID");
SvREFCNT_dec(tmpsv);
}
if (o->op_private) {
- SV *tmpsv = newSVpvn("", 0);
+ SV * const tmpsv = newSVpvn("", 0);
if (PL_opargs[o->op_type] & OA_TARGLEX) {
if (o->op_private & OPpTARGET_MY)
sv_catpv(tmpsv, ",TARGET_MY");
S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
#else
if (cSVOPo->op_sv) {
- SV *tmpsv1 = newSV(0);
- SV *tmpsv2 = newSVpvn("",0);
+ SV * const tmpsv1 = newSV(0);
+ SV * const tmpsv2 = newSVpvn("",0);
char *s;
STRLEN len;
SvUTF8_on(tmpsv1);
}
if (PL_madskills && o->op_madprop) {
- SV *tmpsv = newSVpvn("", 0);
- MADPROP* mp = o->op_madprop;
+ char prevkey = '\0';
+ SV * const tmpsv = newSVpvn("", 0);
+ const MADPROP* mp = o->op_madprop;
+
sv_utf8_upgrade(tmpsv);
if (!contents) {
contents = 1;
sv_setpvn(tmpsv,"\"",1);
if (tmp)
sv_catxmlpvn(tmpsv, &tmp, 1, 0);
+ if ((tmp == '_') || (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
+ sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
+ else
+ prevkey = tmp;
sv_catpv(tmpsv, "\"");
switch (mp->mad_type) {
case MAD_NULL: