X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=e7bd0036254af35800fad7ed9347ffcba7f34aa1;hb=ed79a026b5aec9cc3f786c2971aa15a4b21f396c;hp=6e332c51a6d27865e25f8f957ffc97ec454ef06d;hpb=00df9076cdf35146bc1b44c688065deb7ae6b3ae;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 6e332c5..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. */
     }
 }
 
@@ -2437,14 +2440,15 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
 {
     if (SvPOK(sv) && SvUTF8(sv)) {
         char *c = SvPVX(sv);
-	STRLEN len = SvCUR(sv);
+	STRLEN len = SvCUR(sv) + 1;	/* include trailing NUL */
         if (!utf8_to_bytes((U8*)c, &len)) {
 	    if (fail_ok)
 		return FALSE;
 	    else
-		Perl_croak("big byte");
+		Perl_croak(aTHX_ "big byte");
 	}
 	SvCUR(sv) = len - 1;
+	SvUTF8_off(sv);
     }
     return TRUE;
 }
@@ -5115,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
@@ -6319,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;
@@ -6401,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;