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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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)