From: gfx <gfuji@cpan.org>
Date: Fri, 28 Aug 2009 05:05:26 +0000 (+0900)
Subject: Fix magic stuff
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=80457d1273ba779335e0fd9e97d49c58d5d7fbe9;p=gitmo%2FClass-MOP.git

Fix magic stuff
---

diff --git a/mop.h b/mop.h
index ccb0ea5..14774b7 100644
--- a/mop.h
+++ b/mop.h
@@ -90,6 +90,7 @@ const mop_instance_vtbl* mop_get_default_instance_vtbl(pTHX);
 #define MOP_mg_ptr(mg)   ((mg)->mg_ptr)
 #define MOP_mg_vtbl(mg)  ((const mop_instance_vtbl*)MOP_mg_ptr(mg))
 #define MOP_mg_flags(mg) ((mg)->mg_private)
+#define MOP_mg_virtual(mg) ((mg)->mg_virtual)
 
 #define MOP_mg_obj_refcounted_on(mg)    (void)((mg)->mg_flags |= MGf_REFCOUNTED);
 
@@ -116,7 +117,8 @@ MAGIC* mop_attr_get_mg(pTHX_ SV* const attr);
 SV*    mop_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv);
 MAGIC* mop_accessor_get_mg(pTHX_ CV* const cv);
 
-CV*    mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSPROTO(accessor_impl), const mop_instance_vtbl* vtbl);
+CV*    mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl, const mop_instance_vtbl* vtbl);
+CV*    mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSUBADDR_t const accessor_impl, mop_instance_vtbl* const vtbl);
 
 #define INSTALL_SIMPLE_READER(klass, name)                  INSTALL_SIMPLE_READER_WITH_KEY(klass, name, name)
 #define INSTALL_SIMPLE_READER_WITH_KEY(klass, name, key)    (void)mop_install_accessor(aTHX_ "Class::MOP::" #klass "::" #name, #key, sizeof(#key)-1, mop_xs_simple_reader, NULL)
diff --git a/xs/MethodAccessor.xs b/xs/MethodAccessor.xs
index 0e04011..57c484c 100644
--- a/xs/MethodAccessor.xs
+++ b/xs/MethodAccessor.xs
@@ -21,7 +21,7 @@ mop_accessor_get_mg(pTHX_ CV* const xsub){
 }
 
 CV*
-mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSPROTO(accessor_impl), const mop_instance_vtbl* vtbl){
+mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl, const mop_instance_vtbl* vtbl){
     CV* const xsub  = newXS((char*)fq_name, accessor_impl, __FILE__);
     SV* const keysv = newSVpvn_share(key, keylen, 0U);
     MAGIC* mg;
@@ -47,8 +47,8 @@ mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32
 }
 
 
-static CV*
-mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSPROTO(accessor_impl), mop_instance_vtbl* const vtbl){
+CV*
+mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSUBADDR_t const accessor_impl, mop_instance_vtbl* const vtbl){
     /* $key = $accessor->associated_attribute->name */
     SV* const attr = mop_call0(aTHX_ accessor, mop_associated_attribute);
     SV* const key  = mop_call0(aTHX_ attr, mop_name);
@@ -61,13 +61,10 @@ mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSPROTO(accessor_impl), mo
     CV* const xsub = newXS(NULL, accessor_impl, __FILE__);
     sv_2mortal((SV*)xsub);
 
-    /* XXX: when attr is destroyed, all the associated xsub must be released */
-    CvXSUBANY(xsub).any_ptr = (void*)mg;
-
     MOP_mg_obj(mg) = newSVpvn_share(kpv, klen, 0U);
     MOP_mg_obj_refcounted_on(mg);
 
-    MOP_mg_ptr(mg) = vtbl; /* FIXME */
+    CvXSUBANY(xsub).any_ptr = sv_magicext((SV*)xsub, MOP_mg_obj(mg), PERL_MAGIC_ext, MOP_mg_virtual(mg), (char*)vtbl, 0);
 
     return xsub;
 }