}
tsv = NEWSV(0,0);
if (SvOBJECT(sv))
- Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
+ if (HvNAME(SvSTASH(sv)))
+ Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
+ else
+ Perl_sv_setpvf(aTHX_ tsv, "__ANON__=%s", s);
else
sv_setpv(tsv, s);
Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv));
if (dtype < SVt_RV)
sv_upgrade(dstr, SVt_RV);
else if (dtype == SVt_PVGV &&
- SvTYPE(SvRV(sstr)) == SVt_PVGV) {
+ SvROK(sstr) && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
sstr = SvRV(sstr);
if (sstr == dstr) {
if (GvIMPORTED(dstr) != GVf_IMPORTED
SvPOK(sv) must be true and the C<ptr> must be a pointer to somewhere inside
the string buffer. The C<ptr> becomes the first character of the adjusted
string. Uses the "OOK hack".
+Beware: after this function returns, C<ptr> and SvPVX(sv) may no longer
+refer to the same chunk of data.
=cut
*/
Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)
{
register STRLEN delta;
-
if (!ptr || !SvPOKp(sv))
return;
+ delta = ptr - SvPVX(sv);
SV_CHECK_THINKFIRST(sv);
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv,SVt_PVIV);
SvFLAGS(sv) |= SVf_OOK;
}
SvNIOK_off(sv);
- delta = ptr - SvPVX(sv);
SvLEN(sv) -= delta;
SvCUR(sv) -= delta;
SvPVX(sv) += delta;
mg = mg_find(sv, PERL_MAGIC_utf8);
if (mg && mg->mg_ptr) {
cache = (STRLEN *) mg->mg_ptr;
- if (cache[1] == *offsetp) {
+ if (cache[1] == (STRLEN)*offsetp) {
/* An exact match. */
*offsetp = cache[0];
return;
}
- else if (cache[1] < *offsetp) {
+ else if (cache[1] < (STRLEN)*offsetp) {
/* We already know part of the way. */
len = cache[0];
s += cache[1];
while (backw--) {
p--;
- while (UTF8_IS_CONTINUATION(*p))
+ while (UTF8_IS_CONTINUATION(*p)) {
p--;
+ backw--;
+ }
ubackw++;
}
cache[0] -= ubackw;
-
+ *offsetp = cache[0];
return;
}
}
Stat_t st;
if (!PerlLIO_fstat(PerlIO_fileno(fp), &st) && S_ISREG(st.st_mode)) {
Off_t offset = PerlIO_tell(fp);
- if (offset != (Off_t) -1) {
+ if (offset != (Off_t) -1 && st.st_size + append > offset) {
(void) SvGROW(sv, (STRLEN)((st.st_size - offset) + append + 1));
}
}
Perl_sv_reftype(pTHX_ SV *sv, int ob)
{
if (ob && SvOBJECT(sv)) {
- return HvNAME(SvSTASH(sv));
+ if (HvNAME(SvSTASH(sv)))
+ return HvNAME(SvSTASH(sv));
+ else
+ return "__ANON__";
}
else {
switch (SvTYPE(sv)) {
sv = (SV*)SvRV(sv);
if (!SvOBJECT(sv))
return 0;
+ if (!HvNAME(SvSTASH(sv)))
+ return 0;
return strEQ(HvNAME(SvSTASH(sv)), name);
}
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");
have = esignlen + zeros + elen;
need = (have > width ? have : width);
IoPAGE(dstr) = IoPAGE(sstr);
IoPAGE_LEN(dstr) = IoPAGE_LEN(sstr);
IoLINES_LEFT(dstr) = IoLINES_LEFT(sstr);
+ if(IoFLAGS(sstr) & IOf_FAKE_DIRP) {
+ /* I have no idea why fake dirp (rsfps)
+ should be treaded differently but otherwise
+ we end up with leaks -- sky*/
+ IoTOP_GV(dstr) = gv_dup_inc(IoTOP_GV(sstr), param);
+ IoFMT_GV(dstr) = gv_dup_inc(IoFMT_GV(sstr), param);
+ IoBOTTOM_GV(dstr) = gv_dup_inc(IoBOTTOM_GV(sstr), param);
+ } else {
+ IoTOP_GV(dstr) = gv_dup(IoTOP_GV(sstr), param);
+ IoFMT_GV(dstr) = gv_dup(IoFMT_GV(sstr), param);
+ IoBOTTOM_GV(dstr) = gv_dup(IoBOTTOM_GV(sstr), param);
+ }
IoTOP_NAME(dstr) = SAVEPV(IoTOP_NAME(sstr));
- IoTOP_GV(dstr) = gv_dup(IoTOP_GV(sstr), param);
IoFMT_NAME(dstr) = SAVEPV(IoFMT_NAME(sstr));
- IoFMT_GV(dstr) = gv_dup(IoFMT_GV(sstr), param);
IoBOTTOM_NAME(dstr) = SAVEPV(IoBOTTOM_NAME(sstr));
- IoBOTTOM_GV(dstr) = gv_dup(IoBOTTOM_GV(sstr), param);
IoSUBPROCESS(dstr) = IoSUBPROCESS(sstr);
IoTYPE(dstr) = IoTYPE(sstr);
IoFLAGS(dstr) = IoFLAGS(sstr);
PL_markstack = 0;
PL_scopestack = 0;
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);
PL_markstack = 0;
PL_scopestack = 0;
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);
/* sort() routine */
PL_sort_RealCmp = proto_perl->Isort_RealCmp;
+ /* Not really needed/useful since the reenrant_retint is "volatile",
+ * but do it for consistency's sake. */
+ PL_reentrant_retint = proto_perl->Ireentrant_retint;
+
+ /* Hooks to shared SVs and locks. */
+ PL_sharehook = proto_perl->Isharehook;
+ PL_lockhook = proto_perl->Ilockhook;
+ PL_unlockhook = proto_perl->Iunlockhook;
+ PL_threadhook = proto_perl->Ithreadhook;
+
+ PL_runops_std = proto_perl->Irunops_std;
+ PL_runops_dbg = proto_perl->Irunops_dbg;
+
+#ifdef THREADS_HAVE_PIDS
+ PL_ppid = proto_perl->Ippid;
+#endif
+
/* swatch cache */
PL_last_swash_hv = Nullhv; /* reinits on demand */
PL_last_swash_klen = 0;