From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 28 Jan 2006 12:49:15 +0000 (+0000)
Subject: Pull the other large chunk of PVGV assignment code into S_pvgv_assign.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b8473700d76df372cb0ff6b7c4953731e2d985c2;p=p5sagit%2Fp5-mst-13.2.git

Pull the other large chunk of PVGV assignment code into S_pvgv_assign.
There seems to be some duplication with S_glob_assign.

p4raw-id: //depot/perl@26978
---

diff --git a/sv.c b/sv.c
index 6502392..913d4c8 100644
--- a/sv.c
+++ b/sv.c
@@ -2964,6 +2964,136 @@ S_glob_assign(pTHX_ SV *dstr, SV *sstr, const int dtype)
     return;
 }
 
+static void
+S_pvgv_assign(pTHX_ SV *dstr, SV *sstr) {
+    SV * const sref = SvREFCNT_inc(SvRV(sstr));
+    SV *dref = NULL;
+    const int intro = GvINTRO(dstr);
+
+#ifdef GV_UNIQUE_CHECK
+    if (GvUNIQUE((GV*)dstr)) {
+	Perl_croak(aTHX_ PL_no_modify);
+    }
+#endif
+
+    if (intro) {
+	GvINTRO_off(dstr);	/* one-shot flag */
+	GvLINE(dstr) = CopLINE(PL_curcop);
+	GvEGV(dstr) = (GV*)dstr;
+    }
+    GvMULTI_on(dstr);
+    switch (SvTYPE(sref)) {
+    case SVt_PVAV:
+	if (intro)
+	    SAVEGENERICSV(GvAV(dstr));
+	else
+	    dref = (SV*)GvAV(dstr);
+	GvAV(dstr) = (AV*)sref;
+	if (!GvIMPORTED_AV(dstr)
+	    && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+	    {
+		GvIMPORTED_AV_on(dstr);
+	    }
+	break;
+    case SVt_PVHV:
+	if (intro)
+	    SAVEGENERICSV(GvHV(dstr));
+	else
+	    dref = (SV*)GvHV(dstr);
+	GvHV(dstr) = (HV*)sref;
+	if (!GvIMPORTED_HV(dstr)
+	    && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+	    {
+		GvIMPORTED_HV_on(dstr);
+	    }
+	break;
+    case SVt_PVCV:
+	if (intro) {
+	    if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) {
+		SvREFCNT_dec(GvCV(dstr));
+		GvCV(dstr) = Nullcv;
+		GvCVGEN(dstr) = 0; /* Switch off cacheness. */
+		PL_sub_generation++;
+	    }
+	    SAVEGENERICSV(GvCV(dstr));
+	}
+	else
+	    dref = (SV*)GvCV(dstr);
+	if (GvCV(dstr) != (CV*)sref) {
+	    CV* const cv = GvCV(dstr);
+	    if (cv) {
+		if (!GvCVGEN((GV*)dstr) &&
+		    (CvROOT(cv) || CvXSUB(cv)))
+		    {
+			/* Redefining a sub - warning is mandatory if
+			   it was a const and its value changed. */
+			if (CvCONST(cv)	&& CvCONST((CV*)sref)
+			    && cv_const_sv(cv) == cv_const_sv((CV*)sref)) {
+			    /* They are 2 constant subroutines generated from
+			       the same constant. This probably means that
+			       they are really the "same" proxy subroutine
+			       instantiated in 2 places. Most likely this is
+			       when a constant is exported twice.  Don't warn.
+			    */
+			}
+			else if (ckWARN(WARN_REDEFINE)
+				 || (CvCONST(cv)
+				     && (!CvCONST((CV*)sref)
+					 || sv_cmp(cv_const_sv(cv),
+						   cv_const_sv((CV*)sref))))) {
+			    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+					CvCONST(cv)
+					? "Constant subroutine %s::%s redefined"
+					: "Subroutine %s::%s redefined",
+					HvNAME_get(GvSTASH((GV*)dstr)),
+					GvENAME((GV*)dstr));
+			}
+		    }
+		if (!intro)
+		    cv_ckproto(cv, (GV*)dstr,
+			       SvPOK(sref) ? SvPVX_const(sref) : Nullch);
+	    }
+	    GvCV(dstr) = (CV*)sref;
+	    GvCVGEN(dstr) = 0; /* Switch off cacheness. */
+	    GvASSUMECV_on(dstr);
+	    PL_sub_generation++;
+	}
+	if (!GvIMPORTED_CV(dstr) && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) {
+	    GvIMPORTED_CV_on(dstr);
+	}
+	break;
+    case SVt_PVIO:
+	if (intro)
+	    SAVEGENERICSV(GvIOp(dstr));
+	else
+	    dref = (SV*)GvIOp(dstr);
+	GvIOp(dstr) = (IO*)sref;
+	break;
+    case SVt_PVFM:
+	if (intro)
+	    SAVEGENERICSV(GvFORM(dstr));
+	else
+	    dref = (SV*)GvFORM(dstr);
+	GvFORM(dstr) = (CV*)sref;
+	break;
+    default:
+	if (intro)
+	    SAVEGENERICSV(GvSV(dstr));
+	else
+	    dref = (SV*)GvSV(dstr);
+	GvSV(dstr) = sref;
+	if (!GvIMPORTED_SV(dstr) && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) {
+	    GvIMPORTED_SV_on(dstr);
+	}
+	break;
+    }
+    if (dref)
+	SvREFCNT_dec(dref);
+    if (SvTAINTED(sstr))
+	SvTAINT(dstr);
+    return;
+}
+
 void
 Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 {
@@ -3120,142 +3250,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 
     if (sflags & SVf_ROK) {
 	if (dtype >= SVt_PV) {
-	    if (dtype == SVt_PVGV) {
-		SV * const sref = SvREFCNT_inc(SvRV(sstr));
-		SV *dref = NULL;
-		const int intro = GvINTRO(dstr);
-
-#ifdef GV_UNIQUE_CHECK
-                if (GvUNIQUE((GV*)dstr)) {
-                    Perl_croak(aTHX_ PL_no_modify);
-                }
-#endif
-
-		if (intro) {
-		    GvINTRO_off(dstr);	/* one-shot flag */
-		    GvLINE(dstr) = CopLINE(PL_curcop);
-		    GvEGV(dstr) = (GV*)dstr;
-		}
-		GvMULTI_on(dstr);
-		switch (SvTYPE(sref)) {
-		case SVt_PVAV:
-		    if (intro)
-			SAVEGENERICSV(GvAV(dstr));
-		    else
-			dref = (SV*)GvAV(dstr);
-		    GvAV(dstr) = (AV*)sref;
-		    if (!GvIMPORTED_AV(dstr)
-			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
-		    {
-			GvIMPORTED_AV_on(dstr);
-		    }
-		    break;
-		case SVt_PVHV:
-		    if (intro)
-			SAVEGENERICSV(GvHV(dstr));
-		    else
-			dref = (SV*)GvHV(dstr);
-		    GvHV(dstr) = (HV*)sref;
-		    if (!GvIMPORTED_HV(dstr)
-			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
-		    {
-			GvIMPORTED_HV_on(dstr);
-		    }
-		    break;
-		case SVt_PVCV:
-		    if (intro) {
-			if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) {
-			    SvREFCNT_dec(GvCV(dstr));
-			    GvCV(dstr) = Nullcv;
-			    GvCVGEN(dstr) = 0; /* Switch off cacheness. */
-			    PL_sub_generation++;
-			}
-			SAVEGENERICSV(GvCV(dstr));
-		    }
-		    else
-			dref = (SV*)GvCV(dstr);
-		    if (GvCV(dstr) != (CV*)sref) {
-			CV* const cv = GvCV(dstr);
-			if (cv) {
-			    if (!GvCVGEN((GV*)dstr) &&
-				(CvROOT(cv) || CvXSUB(cv)))
-			    {
- 				/* Redefining a sub - warning is mandatory if
- 				   it was a const and its value changed. */
-				if (CvCONST(cv)	&& CvCONST((CV*)sref)
-				    && cv_const_sv(cv)
-				    == cv_const_sv((CV*)sref)) {
-				    /* They are 2 constant subroutines
-				       generated from the same constant.
-				       This probably means that they are
-				       really the "same" proxy subroutine
-				       instantiated in 2 places. Most likely
-				       this is when a constant is exported
-				       twice.  Don't warn.  */
-				}
-				else if (ckWARN(WARN_REDEFINE)
- 				    || (CvCONST(cv)
- 					&& (!CvCONST((CV*)sref)
- 					    || sv_cmp(cv_const_sv(cv),
- 						      cv_const_sv((CV*)sref)))))
- 				{
- 				    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
- 					CvCONST(cv)
- 					? "Constant subroutine %s::%s redefined"
- 					: "Subroutine %s::%s redefined",
-					HvNAME_get(GvSTASH((GV*)dstr)),
- 					GvENAME((GV*)dstr));
- 				}
-			    }
-			    if (!intro)
-				cv_ckproto(cv, (GV*)dstr,
-					   SvPOK(sref)
-					   ? SvPVX_const(sref) : Nullch);
-			}
-			GvCV(dstr) = (CV*)sref;
-			GvCVGEN(dstr) = 0; /* Switch off cacheness. */
-			GvASSUMECV_on(dstr);
-			PL_sub_generation++;
-		    }
-		    if (!GvIMPORTED_CV(dstr)
-			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
-		    {
-			GvIMPORTED_CV_on(dstr);
-		    }
-		    break;
-		case SVt_PVIO:
-		    if (intro)
-			SAVEGENERICSV(GvIOp(dstr));
-		    else
-			dref = (SV*)GvIOp(dstr);
-		    GvIOp(dstr) = (IO*)sref;
-		    break;
-		case SVt_PVFM:
-		    if (intro)
-			SAVEGENERICSV(GvFORM(dstr));
-		    else
-			dref = (SV*)GvFORM(dstr);
-		    GvFORM(dstr) = (CV*)sref;
-		    break;
-		default:
-		    if (intro)
-			SAVEGENERICSV(GvSV(dstr));
-		    else
-			dref = (SV*)GvSV(dstr);
-		    GvSV(dstr) = sref;
-		    if (!GvIMPORTED_SV(dstr)
-			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
-		    {
-			GvIMPORTED_SV_on(dstr);
-		    }
-		    break;
-		}
-		if (dref)
-		    SvREFCNT_dec(dref);
-		if (SvTAINTED(sstr))
-		    SvTAINT(dstr);
-		return;
-	    }
+	    if (dtype == SVt_PVGV)
+		return S_pvgv_assign(aTHX_ dstr, sstr);
 	    if (SvPVX_const(dstr)) {
 		SvPV_free(dstr);
 		SvLEN_set(dstr, 0);