X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=e7bd0036254af35800fad7ed9347ffcba7f34aa1;hb=ed79a026b5aec9cc3f786c2971aa15a4b21f396c;hp=039e7d6bc5097b9b81b2cbbdd5647f2e39aceb66;hpb=9f9ab9055319ce9b1a2b147cb13f3474dcc9c3b7;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index 039e7d6..e7bd003 100644 --- a/sv.c +++ b/sv.c @@ -1488,7 +1488,8 @@ Perl_sv_2iv(pTHX_ register SV *sv) if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { SV* tmpstr; - if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer))) + if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) && + (SvRV(tmpstr) != SvRV(sv))) return SvIV(tmpstr); return PTR2IV(SvRV(sv)); } @@ -1618,7 +1619,8 @@ Perl_sv_2uv(pTHX_ register SV *sv) if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { SV* tmpstr; - if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer))) + if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) && + (SvRV(tmpstr) != SvRV(sv))) return SvUV(tmpstr); return PTR2UV(SvRV(sv)); } @@ -1785,7 +1787,8 @@ Perl_sv_2nv(pTHX_ register SV *sv) if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { SV* tmpstr; - if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer))) + if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) && + (SvRV(tmpstr) != SvRV(sv))) return SvNV(tmpstr); return PTR2NV(SvRV(sv)); } @@ -2112,7 +2115,8 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { SV* tmpstr; - if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string))) + if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) && + (SvRV(tmpstr) != SvRV(sv))) return SvPV(tmpstr,*lp); sv = (SV*)SvRV(sv); if (!sv) @@ -2359,7 +2363,8 @@ Perl_sv_2bool(pTHX_ register SV *sv) if (SvROK(sv)) { dTHR; SV* tmpsv; - if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_))) + if (SvAMAGIC(sv) && (tmpsv=AMG_CALLun(sv,bool_)) && + (SvRV(tmpsv) != SvRV(sv))) return SvTRUE(tmpsv); return SvRV(sv) != 0; } @@ -2396,28 +2401,26 @@ Convert the PV of an SV to its UTF8-encoded form. void Perl_sv_utf8_upgrade(pTHX_ register SV *sv) { - int hicount; - char *c; - char *s; + char *s, *t; + bool hibit; if (!sv || !SvPOK(sv) || SvUTF8(sv)) return; - /* This function could be much more efficient if we had a FLAG - * to signal if there are any hibit chars in the string + /* This function could be much more efficient if we had a FLAG in SVs + * to signal if there are any hibit chars in the PV. */ - hicount = 0; - for (c = s = SvPVX(sv); c < SvEND(sv); c++) { - if (*c & 0x80) - hicount++; - } + for (s = t = SvPVX(sv), hibit = FALSE; t < SvEND(sv) && !hibit; t++) + if (*t & 0x80) + hibit = TRUE; - if (hicount) { + if (hibit) { STRLEN len = SvCUR(sv) + 1; /* Plus the \0 */ SvPVX(sv) = (char*)bytes_to_utf8((U8*)s, &len); SvCUR(sv) = len - 1; - Safefree(s); /* No longer using what was there before */ + SvLEN(sv) = len; /* No longer know the real size. */ SvUTF8_on(sv); + Safefree(s); /* No longer using what was there before. */ } } @@ -2442,7 +2445,7 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok) if (fail_ok) return FALSE; else - Perl_croak("big byte"); + Perl_croak(aTHX_ "big byte"); } SvCUR(sv) = len - 1; SvUTF8_off(sv); @@ -5116,7 +5119,7 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash) } if (GvHV(gv) && !HvNAME(GvHV(gv))) { hv_clear(GvHV(gv)); -#ifndef VMS /* VMS has no environ array */ +#if !defined( VMS) && !defined(EPOC) /* VMS has no environ array */ if (gv == PL_envgv) environ[0] = Nullch; #endif @@ -6320,7 +6323,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV break; } if (utf) - iv = (IV)utf8_to_uv(vecstr, &ulen, 0); + iv = (IV)utf8_to_uv_chk(vecstr, &ulen, 0); else { iv = *vecstr; ulen = 1; @@ -6402,7 +6405,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV break; } if (utf) - uv = utf8_to_uv(vecstr, &ulen, 0); + uv = utf8_to_uv_chk(vecstr, &ulen, 0); else { uv = *vecstr; ulen = 1;