X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=c9f2e275266516c43c6b132c6bfa1b0340c2f815;hb=d41c018a580ac2dafca04b156c937ada656fd14b;hp=30193b0424b9705e6b093d41ea0a6a63ceb671b8;hpb=7e25a7e974022d38c0b211f280644364acb3c3ee;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index 30193b0..c9f2e27 100644 --- a/sv.c +++ b/sv.c @@ -520,7 +520,7 @@ do_clean_all(pTHX_ SV *sv) DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) )); SvFLAGS(sv) |= SVf_BREAK; if (PL_comppad == (AV*)sv) { - PL_comppad = Nullav; + PL_comppad = NULL; PL_curpad = Null(SV**); } SvREFCNT_dec(sv); @@ -809,14 +809,14 @@ static const struct body_details bodies_by_type[] = { /* 8 bytes on most ILP32 with IEEE doubles */ {sizeof(xpv_allocated), copy_length(XPV, xpv_len) - + relative_STRUCT_OFFSET(XPV, xpv_allocated, xpv_cur), - - relative_STRUCT_OFFSET(XPV, xpv_allocated, xpv_cur), + - relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur), + + relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur), FALSE, NONV, HASARENA}, /* 12 */ {sizeof(xpviv_allocated), copy_length(XPVIV, xiv_u) - + relative_STRUCT_OFFSET(XPVIV, xpviv_allocated, xpv_cur), - - relative_STRUCT_OFFSET(XPVIV, xpviv_allocated, xpv_cur), + - relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur), + + relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur), FALSE, NONV, HASARENA}, /* 20 */ {sizeof(XPVNV), copy_length(XPVNV, xiv_u), 0, FALSE, HADNV, HASARENA}, @@ -831,14 +831,14 @@ static const struct body_details bodies_by_type[] = { /* 20 */ {sizeof(xpvav_allocated), copy_length(XPVAV, xmg_stash) - + relative_STRUCT_OFFSET(XPVAV, xpvav_allocated, xav_fill), - - relative_STRUCT_OFFSET(XPVAV, xpvav_allocated, xav_fill), + - relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill), + + relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill), TRUE, HADNV, HASARENA}, /* 20 */ {sizeof(xpvhv_allocated), copy_length(XPVHV, xmg_stash) - + relative_STRUCT_OFFSET(XPVHV, xpvhv_allocated, xhv_fill), - - relative_STRUCT_OFFSET(XPVHV, xpvhv_allocated, xhv_fill), + - relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill), + + relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill), TRUE, HADNV, HASARENA}, /* 76 */ {sizeof(XPVCV), sizeof(XPVCV), 0, TRUE, HADNV, HASARENA}, @@ -1910,18 +1910,14 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags) } return I_V(Atof(SvPVX_const(sv))); } - if (!SvROK(sv)) { - if (!(SvFLAGS(sv) & SVs_PADTMP)) { - if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) - report_uninit(sv); - } - return 0; + if (SvROK(sv)) { + goto return_rok; } - /* Else this will drop through into the SvROK case just below, which - will return within the {} for all code paths. */ - } - if (SvTHINKFIRST(sv)) { + assert(SvTYPE(sv) >= SVt_PVMG); + /* This falls through to the report_uninit inside S_sv_2iuv_common. */ + } else if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { + return_rok: if (SvAMAGIC(sv)) { SV * const tmpstr=AMG_CALLun(sv,numer); if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { @@ -1987,23 +1983,21 @@ Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags) } return U_V(Atof(SvPVX_const(sv))); } - if (!SvROK(sv)) { - if (!(SvFLAGS(sv) & SVs_PADTMP)) { - if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) - report_uninit(sv); - } - return 0; + if (SvROK(sv)) { + goto return_rok; } - /* Else this will drop through into the SvROK case just below, which - will return within the {} for all code paths. */ - } - if (SvTHINKFIRST(sv)) { + assert(SvTYPE(sv) >= SVt_PVMG); + /* This falls through to the report_uninit inside S_sv_2iuv_common. */ + } else if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { - SV* tmpstr; - if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) && - (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) - return SvUV(tmpstr); - return PTR2UV(SvRV(sv)); + return_rok: + if (SvAMAGIC(sv)) { + SV *const tmpstr = AMG_CALLun(sv,numer); + if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { + return SvUV(tmpstr); + } + } + return PTR2UV(SvRV(sv)); } if (SvIsCOW(sv)) { sv_force_normal_flags(sv, 0); @@ -2054,24 +2048,23 @@ Perl_sv_2nv(pTHX_ register SV *sv) return (NV)SvUVX(sv); else return (NV)SvIVX(sv); - } - if (!SvROK(sv)) { - if (!(SvFLAGS(sv) & SVs_PADTMP)) { - if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) - report_uninit(sv); - } - return (NV)0; - } - /* Else this will drop through into the SvROK case just below, which - will return within the {} for all code paths. */ - } - if (SvTHINKFIRST(sv)) { + } + if (SvROK(sv)) { + goto return_rok; + } + assert(SvTYPE(sv) >= SVt_PVMG); + /* This falls through to the report_uninit near the end of the + function. */ + } else if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { - SV* tmpstr; - if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) && - (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) - return SvNV(tmpstr); - return PTR2NV(SvRV(sv)); + return_rok: + if (SvAMAGIC(sv)) { + SV *const tmpstr = AMG_CALLun(sv,numer); + if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { + return SvNV(tmpstr); + } + } + return PTR2NV(SvRV(sv)); } if (SvIsCOW(sv)) { sv_force_normal_flags(sv, 0); @@ -2357,7 +2350,6 @@ char * Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) { register char *s; - int olderrno; if (!sv) { if (lp) @@ -2415,46 +2407,43 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) return memcpy(s, tbuf, len + 1); } } - if (!SvROK(sv)) { - if (!(SvFLAGS(sv) & SVs_PADTMP)) { - if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) - report_uninit(sv); - } - if (lp) - *lp = 0; - return (char *)""; - } - /* Else this will drop through into the SvROK case just below, which - will return within the {} for all code paths. */ - } - if (SvTHINKFIRST(sv)) { + if (SvROK(sv)) { + goto return_rok; + } + assert(SvTYPE(sv) >= SVt_PVMG); + /* This falls through to the report_uninit near the end of the + function. */ + } else if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { - SV* tmpstr; - - if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) && - (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { - /* Unwrap this: */ - /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); */ - - char *pv; - if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) { - if (flags & SV_CONST_RETURN) { - pv = (char *) SvPVX_const(tmpstr); + return_rok: + if (SvAMAGIC(sv)) { + SV *const tmpstr = AMG_CALLun(sv,string); + if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { + /* Unwrap this: */ + /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); + */ + + char *pv; + if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) { + if (flags & SV_CONST_RETURN) { + pv = (char *) SvPVX_const(tmpstr); + } else { + pv = (flags & SV_MUTABLE_RETURN) + ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr); + } + if (lp) + *lp = SvCUR(tmpstr); } else { - pv = (flags & SV_MUTABLE_RETURN) - ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr); + pv = sv_2pv_flags(tmpstr, lp, flags); } - if (lp) - *lp = SvCUR(tmpstr); - } else { - pv = sv_2pv_flags(tmpstr, lp, flags); + if (SvUTF8(tmpstr)) + SvUTF8_on(sv); + else + SvUTF8_off(sv); + return pv; } - if (SvUTF8(tmpstr)) - SvUTF8_on(sv); - else - SvUTF8_off(sv); - return pv; - } else { + } + { SV *tsv; MAGIC *mg; const SV *const referent = (SV*)SvRV(sv); @@ -2504,10 +2493,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv, SVt_PVIV); - if (isUIOK) - ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf); - else - ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf); + ptr = uiv_2buf(buf, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf); /* inlined from sv_setpvn */ SvGROW_mutable(sv, (STRLEN)(ebuf - ptr + 1)); Move(ptr,SvPVX_mutable(sv),ebuf - ptr,char); @@ -2522,11 +2508,12 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) SvIsUV_on(sv); } else if (SvNOKp(sv)) { + const int olderrno = errno; if (SvTYPE(sv) < SVt_PVNV) sv_upgrade(sv, SVt_PVNV); /* The +20 is pure guesswork. Configure test needed. --jhi */ s = SvGROW_mutable(sv, NV_DIG + 20); - olderrno = errno; /* some Xenix systems wipe out errno here */ + /* some Xenix systems wipe out errno here */ #ifdef apollo if (SvNVX(sv) == 0.0) (void)strcpy(s,"0"); @@ -6717,7 +6704,7 @@ Perl_sv_2io(pTHX_ SV *sv) Perl_croak(aTHX_ PL_no_usym, "filehandle"); if (SvROK(sv)) return sv_2io(SvRV(sv)); - gv = gv_fetchsv(sv, FALSE, SVt_PVIO); + gv = gv_fetchsv(sv, 0, SVt_PVIO); if (gv) io = GvIO(gv); else @@ -6734,6 +6721,7 @@ Perl_sv_2io(pTHX_ SV *sv) Using various gambits, try to get a CV from an SV; in addition, try if possible to set C<*st> and C<*gvp> to the stash and GV associated with it. +The flags in C are passed to sv_fetchsv. =cut */ @@ -6746,7 +6734,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref) CV *cv = Nullcv; if (!sv) - return *gvp = Nullgv, Nullcv; + return *st = NULL, *gvp = Nullgv, Nullcv; switch (SvTYPE(sv)) { case SVt_PVCV: *st = CvSTASH(sv); @@ -6754,6 +6742,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref) return (CV*)sv; case SVt_PVHV: case SVt_PVAV: + *st = NULL; *gvp = Nullgv; return Nullcv; case SVt_PVGV: @@ -6785,8 +6774,10 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref) else gv = gv_fetchsv(sv, lref, SVt_PVCV); *gvp = gv; - if (!gv) + if (!gv) { + *st = NULL; return Nullcv; + } *st = GvESTASH(gv); fix_gv: if (lref && !GvCVu(gv)) { @@ -7269,7 +7260,7 @@ S_sv_unglob(pTHX_ SV *sv) gp_free((GV*)sv); if (GvSTASH(sv)) { sv_del_backref((SV*)GvSTASH(sv), sv); - GvSTASH(sv) = Nullhv; + GvSTASH(sv) = NULL; } sv_unmagic(sv, PERL_MAGIC_glob); Safefree(GvNAME(sv)); @@ -7998,21 +7989,23 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV vecsv = svargs[efix ? efix-1 : svix++]; vecstr = (U8*)SvPV_const(vecsv,veclen); vec_utf8 = DO_UTF8(vecsv); - /* if this is a version object, we need to return the - * stringified representation (which the SvPVX_const has - * already done for us), but not vectorize the args + + /* if this is a version object, we need to convert + * back into v-string notation and then let the + * vectorize happen normally */ - if ( *q == 'd' && sv_derived_from(vecsv,"version") ) - { - q++; /* skip past the rest of the %vd format */ - eptr = (const char *) vecstr; - elen = veclen; - if (elen && *eptr == 'v') { - eptr++; - elen--; - } - vectorize=FALSE; - goto string; + if (sv_derived_from(vecsv, "version")) { + char *version = savesvpv(vecsv); + vecsv = sv_newmortal(); + /* scan_vstring is expected to be called during + * tokenization, so we need to fake up the end + * of the buffer for it + */ + PL_bufend = version + veclen; + scan_vstring(version, vecsv); + vecstr = (U8*)SvPV_const(vecsv, veclen); + vec_utf8 = DO_UTF8(vecsv); + Safefree(version); } } else { @@ -9320,9 +9313,9 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) case SVt_PVNV: case SVt_PVIV: case SVt_PV: - assert(sv_type_details->copy); + assert(sv_type_details->size); if (sv_type_details->arena) { - new_body_inline(new_body, sv_type_details->copy, sv_type); + new_body_inline(new_body, sv_type_details->size, sv_type); new_body = (void*)((char*)new_body - sv_type_details->offset); } else { @@ -9561,7 +9554,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param) : cv_dup(cx->blk_sub.cv,param)); ncx->blk_sub.argarray = (cx->blk_sub.hasargs ? av_dup_inc(cx->blk_sub.argarray, param) - : Nullav); + : NULL); ncx->blk_sub.savearray = av_dup_inc(cx->blk_sub.savearray, param); ncx->blk_sub.olddepth = cx->blk_sub.olddepth; ncx->blk_sub.hasargs = cx->blk_sub.hasargs; @@ -10243,6 +10236,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_minus_p = proto_perl->Iminus_p; PL_minus_l = proto_perl->Iminus_l; PL_minus_a = proto_perl->Iminus_a; + PL_minus_E = proto_perl->Iminus_E; PL_minus_F = proto_perl->Iminus_F; PL_doswitches = proto_perl->Idoswitches; PL_dowarn = proto_perl->Idowarn; @@ -10586,7 +10580,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, #endif /* swatch cache */ - PL_last_swash_hv = Nullhv; /* reinits on demand */ + PL_last_swash_hv = NULL; /* reinits on demand */ PL_last_swash_klen = 0; PL_last_swash_key[0]= '\0'; PL_last_swash_tmps = (U8*)NULL;