SvNV_set(sv, 0);
#endif
- if (new_type == SVt_PVIO)
+ if (new_type == SVt_PVIO) {
+ IO * const io = MUTABLE_IO(sv);
+ GV *iogv = gv_fetchpvs("FileHandle::", 0, SVt_PVHV);
+
+ SvOBJECT_on(io);
+ /* Clear the stashcache because a new IO could overrule a package
+ name */
+ hv_clear(PL_stashcache);
+
+ /* unless exists($main::{FileHandle}) and
+ defined(%main::FileHandle::) */
+ if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
+ iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
+ SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
IoPAGE_LEN(sv) = 60;
+ }
if (old_type < SVt_PV) {
/* referant will be NULL unless the old type was SVt_IV emulating
SVt_RV */
case PERL_MAGIC_qr:
vtable = &PL_vtbl_regexp;
break;
- case PERL_MAGIC_hints:
- /* As this vtable is all NULL, we can reuse it. */
case PERL_MAGIC_sig:
vtable = &PL_vtbl_sig;
break;
case PERL_MAGIC_hintselem:
vtable = &PL_vtbl_hintselem;
break;
+ case PERL_MAGIC_hints:
+ vtable = &PL_vtbl_hints;
+ break;
case PERL_MAGIC_ext:
/* Reserved for use by extensions not perl internals. */
/* Useful for attaching extension internal data to perl vars. */
d = SvPVX(sv);
while (isALPHA(*d)) d++;
while (isDIGIT(*d)) d++;
- if (*d) {
+ if (d < SvEND(sv)) {
#ifdef PERL_PRESERVE_IVUV
/* Got to punt this as an integer if needs be, but we don't issue
warnings. Probably ought to make the sv_iv_please() that does
sv_setnv(sv,Atof(SvPVX_const(sv)) - 1.0); /* punt */
}
+/* this define is used to eliminate a chunk of duplicated but shared logic
+ * it has the suffix __SV_C to signal that it isnt API, and isnt meant to be
+ * used anywhere but here - yves
+ */
+#define PUSH_EXTEND_MORTAL__SV_C(AnSv) \
+ STMT_START { \
+ EXTEND_MORTAL(1); \
+ PL_tmps_stack[++PL_tmps_ix] = (AnSv); \
+ } STMT_END
+
/*
=for apidoc sv_mortalcopy
new_SV(sv);
sv_setsv(sv,oldstr);
- EXTEND_MORTAL(1);
- PL_tmps_stack[++PL_tmps_ix] = sv;
+ PUSH_EXTEND_MORTAL__SV_C(sv);
SvTEMP_on(sv);
return sv;
}
new_SV(sv);
SvFLAGS(sv) = SVs_TEMP;
- EXTEND_MORTAL(1);
- PL_tmps_stack[++PL_tmps_ix] = sv;
+ PUSH_EXTEND_MORTAL__SV_C(sv);
return sv;
}
assert(!(flags & ~(SVf_UTF8|SVs_TEMP)));
new_SV(sv);
sv_setpvn(sv,s,len);
- SvFLAGS(sv) |= (flags & SVf_UTF8);
- return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
+
+ /* This code used to a sv_2mortal(), however we now unroll the call to sv_2mortal()
+ * and do what it does outselves here.
+ * Since we have asserted that flags can only have the SVf_UTF8 and/or SVs_TEMP flags
+ * set above we can use it to enable the sv flags directly (bypassing SvTEMP_on), which
+ * in turn means we dont need to mask out the SVf_UTF8 flag below, which means that we
+ * eleminate quite a few steps than it looks - Yves (explaining patch by gfx)
+ */
+
+ SvFLAGS(sv) |= flags;
+
+ if(flags & SVs_TEMP){
+ PUSH_EXTEND_MORTAL__SV_C(sv);
+ }
+
+ return sv;
}
/*
return NULL;
if (SvREADONLY(sv) && SvIMMORTAL(sv))
return sv;
- EXTEND_MORTAL(1);
- PL_tmps_stack[++PL_tmps_ix] = sv;
+ PUSH_EXTEND_MORTAL__SV_C(sv);
SvTEMP_on(sv);
return sv;
}
SV * const nsv = MUTABLE_SV(ptr_table_fetch(PL_ptr_table,
proto_perl->Itmps_stack[i]));
if (nsv && !SvREFCNT(nsv)) {
- EXTEND_MORTAL(1);
- PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple(nsv);
+ PUSH_EXTEND_MORTAL__SV_C(SvREFCNT_inc_simple(nsv));
}
}
}