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

p4raw-id: //depot/perl@26569

3 files changed, 38 insertions, 13 deletions

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index c902683f6a..18a752ca8b 100644
--- 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 703a876ee3..3478b410dc 100644
--- 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 8f5644bff6..82c88552bf 100644
--- 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)