From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 21 Jan 2007 11:44:16 +0000 (+0000)
Subject: Refactor the common soft-reference code from pp_rv2sv and pp_rv2av
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dc3c76f8b4fe904265e159454587697a06e6e98a;p=p5sagit%2Fp5-mst-13.2.git

Refactor the common soft-reference code from pp_rv2sv and pp_rv2av
into a single routine Perl_softref2xv(). As soft references are
rarely used compared with true references, move this code from pp_hot.c

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

diff --git a/embed.fnc b/embed.fnc
index adb94ef..53e6f4e 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1240,6 +1240,10 @@ s	|SV *	|incpush_if_exists|NN SV *dir
 #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
 sR	|SV*	|refto		|NN SV* sv
 #endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+pRxo	|GV*	|softref2xv	|NN SV *const sv|NN const char *const what \
+				|const U32 type|NN SV ***spp
+#endif
 
 #if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
 s	|I32	|unpack_rec	|NN struct tempsym* symptr|NN const char *s \
diff --git a/embed.h b/embed.h
index 969427f..08fbff4 100644
--- a/embed.h
+++ b/embed.h
@@ -1230,6 +1230,8 @@
 #define refto			S_refto
 #endif
 #endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+#endif
 #if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define unpack_rec		S_unpack_rec
@@ -3430,6 +3432,10 @@
 #define refto(a)		S_refto(aTHX_ a)
 #endif
 #endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#endif
+#endif
 #if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define unpack_rec(a,b,c,d,e)	S_unpack_rec(aTHX_ a,b,c,d,e)
diff --git a/pp.c b/pp.c
index 977c2b7..6f54dc6 100644
--- a/pp.c
+++ b/pp.c
@@ -222,6 +222,50 @@ PP(pp_rv2gv)
     RETURN;
 }
 
+/* Helper function for pp_rv2sv and pp_rv2av  */
+GV *
+Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const U32 type,
+		SV ***spp)
+{
+    dVAR;
+    GV *gv;
+
+    if (PL_op->op_private & HINT_STRICT_REFS) {
+	if (SvOK(sv))
+	    Perl_die(aTHX_ PL_no_symref_sv, sv, what);
+	else
+	    Perl_die(aTHX_ PL_no_usym, what);
+    }
+    if (!SvOK(sv)) {
+	if (PL_op->op_flags & OPf_REF)
+	    Perl_die(aTHX_ PL_no_usym, what);
+	if (ckWARN(WARN_UNINITIALIZED))
+	    report_uninit(sv);
+	if (type != SVt_PV && GIMME_V == G_ARRAY) {
+	    (*spp)--;
+	    return NULL;
+	}
+	**spp = &PL_sv_undef;
+	return NULL;
+    }
+    if ((PL_op->op_flags & OPf_SPECIAL) &&
+	!(PL_op->op_flags & OPf_MOD))
+	{
+	    gv = (GV*)gv_fetchsv(sv, 0, type);
+	    if (!gv
+		&& (!is_gv_magical_sv(sv,0)
+		    || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, type))))
+		{
+		    **spp = &PL_sv_undef;
+		    return NULL;
+		}
+	}
+    else {
+	gv = (GV*)gv_fetchsv(sv, GV_ADD, type);
+    }
+    return gv;
+}
+
 PP(pp_rv2sv)
 {
     dVAR; dSP; dTOPss;
@@ -251,33 +295,9 @@ PP(pp_rv2sv)
 		if (SvROK(sv))
 		    goto wasref;
 	    }
-	    if (PL_op->op_private & HINT_STRICT_REFS) {
-		if (SvOK(sv))
-		    DIE(aTHX_ PL_no_symref_sv, sv, "a SCALAR");
-		else
-		    DIE(aTHX_ PL_no_usym, "a SCALAR");
-	    }
-	    if (!SvOK(sv)) {
-		if (PL_op->op_flags & OPf_REF)
-		    DIE(aTHX_ PL_no_usym, "a SCALAR");
-		if (ckWARN(WARN_UNINITIALIZED))
-		    report_uninit(sv);
-		RETSETUNDEF;
-	    }
-	    if ((PL_op->op_flags & OPf_SPECIAL) &&
-		!(PL_op->op_flags & OPf_MOD))
-	    {
-		gv = (GV*)gv_fetchsv(sv, 0, SVt_PV);
-		if (!gv
-		    && (!is_gv_magical_sv(sv, 0)
-			|| !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV))))
-		{
-		    RETSETUNDEF;
-		}
-	    }
-	    else {
-		gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV);
-	    }
+	    gv = Perl_softref2xv(aTHX_ sv, "a SCALAR", SVt_PV, &sp);
+	    if (!gv)
+		RETURN;
 	}
 	sv = GvSVn(gv);
     }
diff --git a/pp_hot.c b/pp_hot.c
index 821f3b1..dabdc97 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -836,38 +836,10 @@ PP(pp_rv2av)
 		    if (SvROK(sv))
 			goto wasref;
 		}
-		if (PL_op->op_private & HINT_STRICT_REFS) {
-		    if (SvOK(sv))
-			DIE(aTHX_ PL_no_symref_sv, sv,
-			    is_pp_rv2av ? an_array : a_hash);
-		    else
-			DIE(aTHX_ PL_no_usym, is_pp_rv2av ? an_array : a_hash);
-		}
-		if (!SvOK(sv)) {
-		    if (PL_op->op_flags & OPf_REF)
-			DIE(aTHX_ PL_no_usym, is_pp_rv2av ? an_array : a_hash);
-		    if (ckWARN(WARN_UNINITIALIZED))
-			report_uninit(sv);
-		    if (gimme == G_ARRAY) {
-			SP--;
-			RETURN;
-		    }
-		    RETSETUNDEF;
-		}
-		if ((PL_op->op_flags & OPf_SPECIAL) &&
-		    !(PL_op->op_flags & OPf_MOD))
-		{
-		    gv = (GV*)gv_fetchsv(sv, 0, type);
-		    if (!gv
-			&& (!is_gv_magical_sv(sv,0)
-			    || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, type))))
-		    {
-			RETSETUNDEF;
-		    }
-		}
-		else {
-		    gv = (GV*)gv_fetchsv(sv, GV_ADD, type);
-		}
+		gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash,
+				     type, &sp);
+		if (!gv)
+		    RETURN;
 	    }
 	    else {
 		gv = (GV*)sv;
diff --git a/proto.h b/proto.h
index 56a2fd2..b1ec03b 100644
--- a/proto.h
+++ b/proto.h
@@ -3332,6 +3332,14 @@ STATIC SV*	S_refto(pTHX_ SV* sv)
 			__attribute__nonnull__(pTHX_1);
 
 #endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+PERL_CALLCONV GV*	Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const U32 type, SV ***spp)
+			__attribute__warn_unused_result__
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_4);
+
+#endif
 
 #if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
 STATIC I32	S_unpack_rec(pTHX_ struct tempsym* symptr, const char *s, const char *strbeg, const char *strend, const char **new_s)