From ab3a355e8adbf2a0abfe6972f2d194e5becfb2e8 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 7 Sep 2011 22:43:34 -0700
Subject: =?UTF-8?q?shared.xs:=20Refactor=20to=20simplify=20S=5Fget=5FRV?=
 =?UTF-8?q?=E2=80=99s=20callers?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Every function that calls S_get_RV needs this same incantation:

        S_get_RV(aTHX_ sv, ssv);
        /* Look ahead for refs of refs */
        if (SvROK(SvRV(ssv))) {
            SvROK_on(SvRV(sv));
            S_get_RV(aTHX_ SvRV(sv), SvRV(ssv));
        }

Also, S_get_RV keeps repeating SvRV(ssv), even though it assigns it to
sobj at the top.

Also, an upcoming commit will need the ability to pass the referent to
S_get_RV.

So this patch changes S_get_RV to accept a referent instead (eliminat-
ing its multiple use of SvRV) and adds a get_RV macro to take care of
the standard calling rite.
---
 dist/threads-shared/shared.xs | 33 ++++++++++++++++-----------------
 1 file changed, 16 insertions(+), 17 deletions(-)

(limited to 'dist/threads-shared')

diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs
index 13e4a564b4..aea148ea97 100644
--- a/dist/threads-shared/shared.xs
+++ b/dist/threads-shared/shared.xs
@@ -661,14 +661,13 @@ Perl_sharedsv_cond_timedwait(perl_cond *cond, perl_mutex *mut, double abs)
 }
 
 
-/* Given a shared RV, copy it's value to a private RV, also copying the
- * object status of the referent.
+/* Given a thingy referenced by a shared RV, copy it's value to a private
+ * RV, also copying the object status of the referent.
  * If the private side is already an appropriate RV->SV combination, keep
  * it if possible.
  */
 STATIC void
-S_get_RV(pTHX_ SV *sv, SV *ssv) {
-    SV *sobj = SvRV(ssv);
+S_get_RV(pTHX_ SV *sv, SV *sobj) {
     SV *obj;
     if (! (SvROK(sv) &&
            ((obj = SvRV(sv))) &&
@@ -683,7 +682,7 @@ S_get_RV(pTHX_ SV *sv, SV *ssv) {
             sv_setsv_nomg(sv, &PL_sv_undef);
             SvROK_on(sv);
         }
-        obj = S_sharedsv_new_private(aTHX_ SvRV(ssv));
+        obj = S_sharedsv_new_private(aTHX_ sobj);
         SvRV_set(sv, obj);
     }
 
@@ -702,6 +701,16 @@ S_get_RV(pTHX_ SV *sv, SV *ssv) {
     }
 }
 
+/* Every caller of S_get_RV needs this incantation (which cannot go inside
+   S_get_RV itself, as we do not want recursion beyond one level): */
+#define get_RV(sv, sobj)                     \
+        S_get_RV(aTHX_ sv, sobj);             \
+        /* Look ahead for refs of refs */      \
+        if (SvROK(sobj)) {                      \
+            SvROK_on(SvRV(sv));                  \
+            S_get_RV(aTHX_ SvRV(sv), SvRV(sobj)); \
+        }
+
 
 /* ------------ PERL_MAGIC_shared_scalar(n) functions -------------- */
 
@@ -715,12 +724,7 @@ sharedsv_scalar_mg_get(pTHX_ SV *sv, MAGIC *mg)
 
     ENTER_LOCK;
     if (SvROK(ssv)) {
-        S_get_RV(aTHX_ sv, ssv);
-        /* Look ahead for refs of refs */
-        if (SvROK(SvRV(ssv))) {
-            SvROK_on(SvRV(sv));
-            S_get_RV(aTHX_ SvRV(sv), SvRV(ssv));
-        }
+        get_RV(sv, SvRV(ssv));
     } else {
         sv_setsv_nomg(sv, ssv);
     }
@@ -898,12 +902,7 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg)
     if (svp) {
         /* Exists in the array */
         if (SvROK(*svp)) {
-            S_get_RV(aTHX_ sv, *svp);
-            /* Look ahead for refs of refs */
-            if (SvROK(SvRV(*svp))) {
-                SvROK_on(SvRV(sv));
-                S_get_RV(aTHX_ SvRV(sv), SvRV(*svp));
-            }
+            get_RV(sv, SvRV(*svp));
         } else {
             /* $ary->[elem] or $ary->{elem} is a scalar */
             Perl_sharedsv_associate(aTHX_ sv, *svp);
-- 
cgit v1.2.1