add svt_local slot to magic vtable, and fix local $shared

p4raw-id: //depot/perl@26569

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index c902683..18a752c 100644 (file)
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -196,6 +196,7 @@ MGVTBL sharedsv_shared_vtbl = {
  sharedsv_shared_mg_free,      /* free */
  0,                            /* copy */
  0,                            /* dup */
+ 0                             /* local */
 };
 
 /* Access to shared things is heavily based on MAGIC - in mg.h/mg.c/sv.c sense */
@@ -376,7 +377,7 @@ Perl_sharedsv_associate(pTHX_ SV **psv, SV *ssv, shared_sv *data)
                }
                mg = sv_magicext(sv, Nullsv, PERL_MAGIC_shared_scalar,
                                &sharedsv_scalar_vtbl, (char *)data, 0);
-               mg->mg_flags |= (MGf_COPY|MGf_DUP);
+               mg->mg_flags |= (MGf_COPY|MGf_DUP|MGf_LOCAL);
                SvREFCNT_inc(ssv);
                if(SvOBJECT(ssv)) {
                  STRLEN len;
@@ -605,6 +606,28 @@ sharedsv_scalar_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
     return 0;
 }
 
+
+/*
+ * Called during local $shared
+ */
+int
+sharedsv_scalar_mg_local(pTHX_ SV* nsv, MAGIC *mg)
+{
+    MAGIC *nmg;
+    shared_sv *shared = (shared_sv *) mg->mg_ptr;
+    if (shared) {
+       ENTER_LOCK;
+       SvREFCNT_inc(SHAREDSvPTR(shared));
+       LEAVE_LOCK;
+    }
+    nmg = sv_magicext(nsv, mg->mg_obj, mg->mg_type, mg->mg_virtual,
+                           mg->mg_ptr, mg->mg_len);
+    nmg->mg_flags   = mg->mg_flags;
+    nmg->mg_private = mg->mg_private;
+
+    return 0;
+}
+
 MGVTBL sharedsv_scalar_vtbl = {
  sharedsv_scalar_mg_get,       /* get */
  sharedsv_scalar_mg_set,       /* set */
@@ -612,7 +635,8 @@ MGVTBL sharedsv_scalar_vtbl = {
  sharedsv_scalar_mg_clear,     /* clear */
  sharedsv_scalar_mg_free,      /* free */
  0,                            /* copy */
- sharedsv_scalar_mg_dup                /* dup */
+ sharedsv_scalar_mg_dup,       /* dup */
+ sharedsv_scalar_mg_local      /* local */
 };
 
 /* Now the arrays/hashes stuff */
@@ -753,7 +777,8 @@ MGVTBL sharedsv_elem_vtbl = {
  sharedsv_elem_mg_DELETE,      /* clear */
  sharedsv_elem_mg_free,                /* free */
  0,                            /* copy */
- sharedsv_elem_mg_dup          /* dup */
+ sharedsv_elem_mg_dup,         /* dup */
+ 0                             /* local */
 };
 
 U32
@@ -832,7 +857,8 @@ MGVTBL sharedsv_array_vtbl = {
  sharedsv_array_mg_CLEAR,      /* clear */
  sharedsv_array_mg_free,       /* free */
  sharedsv_array_mg_copy,       /* copy */
- sharedsv_array_mg_dup         /* dup */
+ sharedsv_array_mg_dup,                /* dup */
+ 0                             /* local */
 };
 
 =for apidoc sharedsv_unlock

diff --git a/mg.c b/mg.c
index 703a876..3478b41 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -430,15 +430,12 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
            continue;
        }
                
-       if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy) {
-           /* XXX calling the copy method is probably not correct. DAPM */
-           (void)CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv,
-                                   mg->mg_ptr, mg->mg_len);
-       }
-       else {
+       if ((mg->mg_flags & MGf_LOCAL) && vtbl->svt_local)
+           (void)CALL_FPTR(vtbl->svt_local)(aTHX_ nsv, mg);
+       else
            sv_magicext(nsv, mg->mg_obj, mg->mg_type, vtbl,
                            mg->mg_ptr, mg->mg_len);
-       }
+
        /* container types should remain read-only across localization */
        SvFLAGS(nsv) |= SvREADONLY(sv);
     }

diff --git a/mg.h b/mg.h
index 8f5644b..82c8855 100644 (file)
--- a/mg.h
+++ b/mg.h
@@ -20,6 +20,7 @@ struct mgvtbl {
     int                (CPERLscope(*svt_copy)) (pTHX_ SV *sv, MAGIC* mg,
                                        SV *nsv, const char *name, int namlen);
     int                (CPERLscope(*svt_dup))  (pTHX_ MAGIC *mg, CLONE_PARAMS *param);
+    int                (CPERLscope(*svt_local))(pTHX_ SV *nsv, MAGIC *mg);
 };
 #endif
 
@@ -38,8 +39,9 @@ struct magic {
 #define MGf_MINMATCH   1        /* PERL_MAGIC_regex_global only */
 #define MGf_REFCOUNTED 2
 #define MGf_GSKIP      4
-#define MGf_COPY       8
-#define MGf_DUP        16
+#define MGf_COPY       8       /* has an svt_copy  MGVTBL entry */
+#define MGf_DUP     0x10       /* has an svt_dup   MGVTBL entry */
+#define MGf_LOCAL   0x20       /* has an svt_local MGVTBL entry */
 
 #define MgTAINTEDDIR(mg)       (mg->mg_flags & MGf_TAINTEDDIR)
 #define MgTAINTEDDIR_on(mg)    (mg->mg_flags |= MGf_TAINTEDDIR)