Escapes at most the first "count" chars of pv and puts the results into
dsv such that the size of the escaped string will not exceed "max" chars
-and will not contain any incomplete escape sequences.
+and will not contain any incomplete escape sequences. The number of bytes
+escaped will be returned in the STRLEN *escaped parameter if it is not null.
+When the dsv parameter is null no escaping actually occurs, but the number
+of bytes that would be escaped were it not null will be calculated.
If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
will also be escaped.
PERL_ARGS_ASSERT_PV_ESCAPE;
- if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
+ if (dsv && !(flags & PERL_PV_ESCAPE_NOCLEAR)) {
/* This won't alter the UTF-8 flag */
sv_setpvs(dsv, "");
}
if ( max && (wrote + chsize > max) ) {
break;
} else if (chsize > 1) {
- sv_catpvn(dsv, octbuf, chsize);
+ if (dsv)
+ sv_catpvn(dsv, octbuf, chsize);
wrote += chsize;
} else {
/* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
Or add a new API call sv_catpvc(). Think about that name, and
how to keep it clear that it's unlike the s of catpvs, which is
really an array of octets, not a string. */
- Perl_sv_catpvf( aTHX_ dsv, "%c", c);
+ if (dsv)
+ Perl_sv_catpvf( aTHX_ dsv, "%c", c);
wrote++;
}
if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
}
if (escaped != NULL)
*escaped= pv - str;
- return SvPVX(dsv);
+ return dsv ? SvPVX(dsv) : NULL;
}
/*
=for apidoc pv_pretty
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags )
{
- const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
+ const U8 *quotes = (U8*)((flags & PERL_PV_PRETTY_QUOTE) ? "\"\"" :
+ (flags & PERL_PV_PRETTY_LTGT) ? "<>" : NULL);
STRLEN escaped;
+ STRLEN max_adjust= 0;
+ STRLEN orig_cur;
PERL_ARGS_ASSERT_PV_PRETTY;
if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
- /* This won't alter the UTF-8 flag */
- sv_setpvs(dsv, "");
+ /* This won't alter the UTF-8 flag */
+ sv_setpvs(dsv, "");
}
+ orig_cur= SvCUR(dsv);
- if ( dq == '"' )
- sv_catpvs(dsv, "\"");
- else if ( flags & PERL_PV_PRETTY_LTGT )
- sv_catpvs(dsv, "<");
+ if ( quotes )
+ Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[0]);
if ( start_color != NULL )
sv_catpv(dsv, start_color);
-
- pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
-
+
+ if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
+ if (quotes)
+ max_adjust += 2;
+ assert(max > max_adjust);
+ pv_escape( NULL, str, count, max - max_adjust, &escaped, flags );
+ if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
+ max_adjust += 3;
+ assert(max > max_adjust);
+ }
+
+ pv_escape( dsv, str, count, max - max_adjust, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
+
if ( end_color != NULL )
sv_catpv(dsv, end_color);
- if ( dq == '"' )
- sv_catpvs( dsv, "\"");
- else if ( flags & PERL_PV_PRETTY_LTGT )
- sv_catpvs(dsv, ">");
+ if ( quotes )
+ Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[1]);
if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
sv_catpvs(dsv, "...");
+
+ if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
+ while( SvCUR(dsv) - orig_cur < max )
+ sv_catpvs(dsv," ");
+ }
return SvPVX(dsv);
}
else
ch = '/';
if (PM_GETRE(pm))
- Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
- ch, RX_PRECOMP(PM_GETRE(pm)), ch,
+ Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%.*s%c%s\n",
+ ch,(int)RX_PRELEN(PM_GETRE(pm)), RX_PRECOMP(PM_GETRE(pm)), ch,
(pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
else
Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
if (o->op_targ) {
if (optype == OP_NULL) {
Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]);
- if (o->op_targ == OP_NEXTSTATE) {
- if (CopLINE(cCOPo))
- Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
- (UV)CopLINE(cCOPo));
- if (CopSTASHPV(cCOPo)) {
- SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
- HV *stash = CopSTASH(cCOPo);
- const char * const hvname = HvNAME_get(stash);
-
- Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
- generic_pv_escape( tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash)));
- }
- if (CopLABEL(cCOPo)) {
- SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
- STRLEN label_len;
- U32 label_flags;
- const char *label = CopLABEL_len_flags(cCOPo,
- &label_len,
- &label_flags);
- Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
- generic_pv_escape( tmpsv, label, label_len,(label_flags & SVf_UTF8)));
- }
-
- }
}
else
Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
#ifndef USE_ITHREADS
/* with ITHREADS, consts are stored in the pad, and the right pad
* may not be active here, so skip */
- Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
+ Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cMETHOPx_meth(o)));
#endif
break;
+ case OP_NULL:
+ if (o->op_targ != OP_NEXTSTATE && o->op_targ != OP_DBSTATE)
+ break;
+ /* FALLTHROUGH */
case OP_NEXTSTATE:
case OP_DBSTATE:
if (CopLINE(cCOPo))
generic_pv_escape( tmpsv, label, label_len,
(label_flags & SVf_UTF8)));
}
+ Perl_dump_indent(aTHX_ level, file, "SEQ = %d\n",
+ cCOPo->cop_seq);
break;
case OP_ENTERLOOP:
Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
{SVf_OOK, "OOK,"},
{SVf_FAKE, "FAKE,"},
{SVf_READONLY, "READONLY,"},
- {SVf_IsCOW, "IsCOW,"},
+ {SVf_PROTECT, "PROTECT,"},
{SVf_BREAK, "BREAK,"},
- {SVf_AMAGIC, "OVERLOAD,"},
{SVp_IOK, "pIOK,"},
{SVp_NOK, "pNOK,"},
{SVp_POK, "pPOK,"}
{SVphv_SHAREKEYS, "SHAREKEYS,"},
{SVphv_LAZYDEL, "LAZYDEL,"},
{SVphv_HASKFLAGS, "HASKFLAGS,"},
+ {SVf_AMAGIC, "OVERLOAD,"},
{SVphv_CLONEABLE, "CLONEABLE,"}
};
{RXf_PMf_SINGLELINE, "PMf_SINGLELINE,"},
{RXf_PMf_FOLD, "PMf_FOLD,"},
{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
+ {RXf_PMf_EXTENDED_MORE, "PMf_EXTENDED_MORE,"},
{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
{RXf_IS_ANCHORED, "IS_ANCHORED,"},
{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
if (!((flags & SVpad_NAME) == SVpad_NAME
&& (type == SVt_PVMG || type == SVt_PVNV))) {
- if ((flags & SVs_PADMY) && (flags & SVs_PADSTALE))
+ if ((flags & SVs_PADSTALE))
sv_catpv(d, "PADSTALE,");
}
if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
- if (!(flags & SVs_PADMY) && (flags & SVs_PADTMP))
+ if ((flags & SVs_PADTMP))
sv_catpv(d, "PADTMP,");
- if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
}
append_flags(d, flags, first_sv_flags_names);
if (flags & SVf_ROK) {
sv_catpv(d, "ROK,");
if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
}
+ if (flags & SVf_IsCOW && type != SVt_PVHV) sv_catpvs(d, "IsCOW,");
append_flags(d, flags, second_sv_flags_names);
if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
&& type != SVt_PVAV) {
Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
- Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
- if (nest < maxnest) {
- do_dump_pad(level+1, file, CvPADLIST(sv), 0);
+ if (!CvISXSUB(sv)) {
+ Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
+ if (nest < maxnest) {
+ do_dump_pad(level+1, file, CvPADLIST(sv), 0);
+ }
}
+ else
+ Perl_dump_indent(aTHX_ level, file, " HSCXT = 0x%p\n", CvHSCXT(sv));
{
const CV * const outside = CvOUTSIDE(sv);
Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
assert(SvROK(cGVOPo_gv));
assert(SvTYPE(SvRV(cGVOPo_gv)) == SVt_PVCV);
PerlIO_printf(Perl_debug_log, "(cv ref: %s)",
- SvPV_nolen_const(cv_name((CV *)SvRV(cGVOPo_gv),sv)));
+ SvPV_nolen_const(cv_name((CV *)SvRV(cGVOPo_gv),sv,0)));
SvREFCNT_dec_NN(sv);
}
else
https://perl5.git.perl.org / perl5.git / blobdiff