{
bool pad = (obase->op_type == OP_PADAV || obase->op_type == OP_PADHV);
bool hash = (obase->op_type == OP_PADHV || obase->op_type == OP_RV2HV);
- I32 index;
- SV *keysv;
+ I32 index = 0;
+ SV *keysv = Nullsv;
int subscript_type = FUV_SUBSCRIPT_WITHIN;
if (pad) { /* @lex, %lex */
Perl_report_uninit(pTHX_ SV* uninit_sv)
{
if (PL_op) {
- SV* varname;
+ SV* varname = Nullsv;
if (uninit_sv) {
varname = find_uninit_var(PL_op, uninit_sv,0);
if (varname)
bool
Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
{
+
char* pv = NULL;
U32 cur = 0;
U32 len = 0;
SvSTASH(sv) = stash;
AvALLOC(sv) = 0;
AvARYLEN(sv) = 0;
- AvFLAGS(sv) = 0;
+ AvFLAGS(sv) = AVf_REAL;
break;
case SVt_PVHV:
SvANY(sv) = new_XPVHV();
*lp = len;
s = SvGROW(sv, len + 1);
SvCUR_set(sv, len);
- (void)strcpy(s, t);
SvPOKp_on(sv);
- return s;
+ return strcpy(s, t);
}
}
Loosely speaking, it performs a copy-by-value, obliterating any previous
content of the destination.
If the C<flags> parameter has the C<SV_GMAGIC> bit set, will C<mg_get> on
-C<ssv> if appropriate, else not. C<sv_setsv> and C<sv_setsv_nomg> are
-implemented in terms of this function.
+C<ssv> if appropriate, else not. If the C<flags> parameter has the
+C<NOSTEAL> bit set then the buffers of temps will not be stolen. <sv_setsv>
+and C<sv_setsv_nomg> are implemented in terms of this function.
You probably want to use one of the assortment of wrappers, such as
C<SvSetSV>, C<SvSetSV_nosteal>, C<SvSetMagicSV> and
!(isSwipe =
(sflags & SVs_TEMP) && /* slated for free anyway? */
!(sflags & SVf_OOK) && /* and not involved in OOK hack? */
+ (!(flags & SV_NOSTEAL)) &&
+ /* and we're allowed to steal temps */
SvREFCNT(sstr) == 1 && /* and no other references to it? */
SvLEN(sstr) && /* and really is a string */
/* and won't be needed again, potentially */
{
if (SvIsCOW(sv))
sv_force_normal_flags(sv, 0);
- return SvOOK_off(sv);
+ SvOOK_off(sv);
+ return 0;
}
#endif
/*
case SVt_PVNV:
case SVt_PVIV:
freescalar:
- (void)SvOOK_off(sv);
+ SvOOK_off(sv);
/* FALL THROUGH */
case SVt_PV:
case SVt_RV:
sv_unref(sv);
continue;
}
- (void)SvOK_off(sv);
+ SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
SvCUR_set(sv, 0);
if (SvPVX(sv) != Nullch)
if (SvTYPE(rv) < SVt_RV)
sv_upgrade(rv, SVt_RV);
else if (SvTYPE(rv) > SVt_RV) {
- (void)SvOOK_off(rv);
+ SvOOK_off(rv);
if (SvPVX(rv) && SvLEN(rv))
Safefree(SvPVX(rv));
SvCUR_set(rv, 0);
SvLEN_set(rv, 0);
}
- (void)SvOK_off(rv);
+ SvOK_off(rv);
SvRV(rv) = sv;
SvROK_on(rv);
/*
=for apidoc sv_setpvf
-Processes its arguments like C<sprintf> and sets an SV to the formatted
-output. Does not handle 'set' magic. See C<sv_setpvf_mg>.
+Works like C<sv_catpvf> but copies the text into the SV instead of
+appending it. Does not handle 'set' magic. See C<sv_setpvf_mg>.
=cut
*/
va_end(args);
}
-/* backend for C<sv_setpvf> and C<sv_setpvf_nocontext> */
+/*
+=for apidoc sv_vsetpvf
+
+Works like C<sv_vcatpvf> but copies the text into the SV instead of
+appending it. Does not handle 'set' magic. See C<sv_vsetpvf_mg>.
+
+Usually used via its frontend C<sv_setpvf>.
+
+=cut
+*/
void
Perl_sv_vsetpvf(pTHX_ SV *sv, const char* pat, va_list* args)
va_end(args);
}
-/* backend for C<sv_setpvf_mg> C<setpvf_mg_nocontext> */
+/*
+=for apidoc sv_vsetpvf_mg
+
+Like C<sv_vsetpvf>, but also handles 'set' magic.
+
+Usually used via its frontend C<sv_setpvf_mg>.
+
+=cut
+*/
void
Perl_sv_vsetpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
output to an SV. If the appended data contains "wide" characters
(including, but not limited to, SVs with a UTF-8 PV formatted with %s,
and characters >255 formatted with %c), the original SV might get
-upgraded to UTF-8. Handles 'get' magic, but not 'set' magic.
-C<SvSETMAGIC()> must typically be called after calling this function
-to handle 'set' magic.
+upgraded to UTF-8. Handles 'get' magic, but not 'set' magic. See
+C<sv_catpvf_mg>.
=cut */
va_end(args);
}
-/* backend for C<sv_catpvf> and C<catpvf_mg_nocontext> */
+/*
+=for apidoc sv_vcatpvf
+
+Processes its arguments like C<vsprintf> and appends the formatted output
+to an SV. Does not handle 'set' magic. See C<sv_vcatpvf_mg>.
+
+Usually used via its frontend C<sv_catpvf>.
+
+=cut
+*/
void
Perl_sv_vcatpvf(pTHX_ SV *sv, const char* pat, va_list* args)
va_end(args);
}
-/* backend for C<catpvf_mg> and C<catpvf_mg_nocontext> */
+/*
+=for apidoc sv_vcatpvf_mg
+
+Like C<sv_vcatpvf>, but also handles 'set' magic.
+
+Usually used via its frontend C<sv_catpvf_mg>.
+
+=cut
+*/
void
Perl_sv_vcatpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
/*
=for apidoc sv_vsetpvfn
-Works like C<vcatpvfn> but copies the text into the SV instead of
+Works like C<sv_vcatpvfn> but copies the text into the SV instead of
appending it.
-Usually used via one of its frontends C<sv_setpvf> and C<sv_setpvf_mg>.
+Usually used via one of its frontends C<sv_vsetpvf> and C<sv_vsetpvf_mg>.
=cut
*/
C<maybe_tainted> if results are untrustworthy (often due to the use of
locales).
-Usually used via one of its frontends C<sv_catpvf> and C<sv_catpvf_mg>.
+Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
=cut
*/
vecsv = svargs[efix ? efix-1 : svix++];
vecstr = (U8*)SvPVx(vecsv,veclen);
vec_utf8 = DO_UTF8(vecsv);
+ /* if this is a version object, we need to return the
+ * stringified representation (which the SvPVX has
+ * already done for us), but not vectorize the args
+ */
+ if ( *q == 'd' && sv_derived_from(vecsv,"version") )
+ {
+ q++; /* skip past the rest of the %vd format */
+ eptr = (char *) vecstr;
+ elen = strlen(eptr);
+ vectorize=FALSE;
+ goto string;
+ }
}
else {
vecstr = (U8*)"";
p = SvEND(sv);
*p = '\0';
}
- /* Use memchr() instead of strchr(), as eptr is not guaranteed */
- /* to point to a null-terminated string. */
- if (left && ckWARN(WARN_PRINTF) && memchr(eptr, '\n', elen) &&
- (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF))
- Perl_warner(aTHX_ packWARN(WARN_PRINTF),
- "Newline in left-justified string for %sprintf",
- (PL_op->op_type == OP_PRTF) ? "" : "s");
-
+
need = (have > width ? have : width);
gap = need - have;
else {
ncx->blk_oldsp = cx->blk_oldsp;
ncx->blk_oldcop = cx->blk_oldcop;
- ncx->blk_oldretsp = cx->blk_oldretsp;
ncx->blk_oldmarksp = cx->blk_oldmarksp;
ncx->blk_oldscopesp = cx->blk_oldscopesp;
ncx->blk_oldpm = cx->blk_oldpm;
ncx->blk_sub.olddepth = cx->blk_sub.olddepth;
ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
ncx->blk_sub.lval = cx->blk_sub.lval;
+ ncx->blk_sub.retop = cx->blk_sub.retop;
break;
case CXt_EVAL:
ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval;
ncx->blk_eval.old_namesv = sv_dup_inc(cx->blk_eval.old_namesv, param);
ncx->blk_eval.old_eval_root = cx->blk_eval.old_eval_root;
ncx->blk_eval.cur_text = sv_dup(cx->blk_eval.cur_text, param);
+ ncx->blk_eval.retop = cx->blk_eval.retop;
break;
case CXt_LOOP:
ncx->blk_loop.label = cx->blk_loop.label;
ncx->blk_sub.gv = gv_dup(cx->blk_sub.gv, param);
ncx->blk_sub.dfoutgv = gv_dup_inc(cx->blk_sub.dfoutgv, param);
ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
+ ncx->blk_sub.retop = cx->blk_sub.retop;
break;
case CXt_BLOCK:
case CXt_NULL:
PL_savestack = 0;
PL_savestack_ix = 0;
PL_savestack_max = -1;
- PL_retstack = 0;
PL_sig_pending = 0;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
# else /* !DEBUGGING */
PL_savestack = 0;
PL_savestack_ix = 0;
PL_savestack_max = -1;
- PL_retstack = 0;
PL_sig_pending = 0;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
# else /* !DEBUGGING */
Newz(54, PL_scopestack, PL_scopestack_max, I32);
Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
- /* next push_return() sets PL_retstack[PL_retstack_ix]
- * NOTE: unlike the others! */
- PL_retstack_ix = proto_perl->Tretstack_ix;
- PL_retstack_max = proto_perl->Tretstack_max;
- Newz(54, PL_retstack, PL_retstack_max, OP*);
- Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, OP*);
-
/* NOTE: si_dup() looks at PL_markstack */
PL_curstackinfo = si_dup(proto_perl->Tcurstackinfo, param);
FREETMPS;
LEAVE;
SvUTF8_on(sv);
+ return SvPVX(sv);
}
- return SvPVX(sv);
+ return SvPOKp(sv) ? SvPVX(sv) : NULL;
}
/*
projects / p5sagit/p5-mst-13.2.git / blobdiff