From: Dave Mitchell <davem@fdisolutions.com>
Date: Mon, 2 Jan 2006 12:09:37 +0000 (+0000)
Subject: add svt_local slot to magic vtable, and fix local $shared
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a5063e7cd8fef802efd25ffe9df2c3748f4254f6;p=p5sagit%2Fp5-mst-13.2.git

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