X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=f918d5ab2722a1cf8a039135d858df3dde86a79b;hb=170c5524f26ec8d57d5b2a5413842df92809a613;hp=f89d624d97bb4bc1c6a385d6cdd7047b6286b405;hpb=71c558c3bb71d4ea530abb3cc25180c1ccf2bedc;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index f89d624..f918d5a 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);
@@ -1910,18 +1910,15 @@ 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.  */
+	assert(SvTYPE(sv) >= SVt_PVMG);
+	/* This falls through to the report_uninit inside S_sv_2iuv_common.  */
     }
     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 +1984,22 @@ 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.  */
+	assert(SvTYPE(sv) >= SVt_PVMG);
+	/* This falls through to the report_uninit inside S_sv_2iuv_common.  */
     }
     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 +2050,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);
@@ -2083,10 +2078,8 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	}
     }
     if (SvTYPE(sv) < SVt_NV) {
-	if (SvTYPE(sv) == SVt_IV)
-	    sv_upgrade(sv, SVt_PVNV);
-	else
-	    sv_upgrade(sv, SVt_NV);
+	/* The logic to use SVt_PVNV if necessary is in sv_upgrade.  */
+	sv_upgrade(sv, SVt_NV);
 #ifdef USE_LONG_DOUBLE
 	DEBUG_c({
 	    STORE_NUMERIC_LOCAL_SET_STANDARD();
@@ -2207,11 +2200,10 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     else  {
 	if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
 	    report_uninit(sv);
-	if (SvTYPE(sv) < SVt_NV)
-	    /* Typically the caller expects that sv_any is not NULL now.  */
-	    /* XXX Ilya implies that this is a bug in callers that assume this
-	       and ideally should be fixed.  */
-	    sv_upgrade(sv, SVt_NV);
+	assert (SvTYPE(sv) >= SVt_NV);
+	/* Typically the caller expects that sv_any is not NULL now.  */
+	/* XXX Ilya implies that this is a bug in callers that assume this
+	   and ideally should be fixed.  */
 	return 0.0;
     }
 #if defined(USE_LONG_DOUBLE)
@@ -2418,46 +2410,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);
@@ -7272,7 +7261,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));
@@ -8001,21 +7990,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 {
@@ -9323,9 +9314,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 {
@@ -9564,7 +9555,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;
@@ -10589,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;