Permalink
Browse files

get_methods

  • Loading branch information...
1 parent 9981d51 commit 42b74c318ce22aad7343c5b427462ae1bc63c6a3 @lestrrat committed Apr 3, 2009
Showing with 64 additions and 24 deletions.
  1. +4 −4 mop.h
  2. +39 −8 mop_class.c
  3. +17 −10 mop_package.c
  4. +4 −2 t/01_load.t
View
@@ -48,13 +48,13 @@ typedef struct _mop_component mop_component;
((sv) ? ((mop_state *) MOP_STATE_FROM_SV(sv))->trace : 0)
static void
-mop_init()
+mop_init(pTHX_)
{
get_hv("mop::class::metaclass_registry", 1);
}
static mop_state *
-mop_state_create(void *ptr, SV *sv) {
+mop_state_create(pTHX_ void *ptr, SV *sv) {
mop_state *st;
Newxz(st, 1, mop_state);
@@ -66,7 +66,7 @@ mop_state_create(void *ptr, SV *sv) {
}
static int
-mop_component_state_has_refs(mop_component *c)
+mop_component_state_has_refs(pTHX_ mop_component *c)
{
if (c->state) {
if (!PL_dirty && SvOK(c->state->sv) && SvREFCNT(c->state->sv) > 1) {
@@ -78,7 +78,7 @@ mop_component_state_has_refs(mop_component *c)
}
static void
-mop_component_state_destroy(mop_component *c)
+mop_component_state_destroy(pTHX_ mop_component *c)
{
if (c->state != NULL) {
PerlIO_printf(PerlIO_stderr(), " DESTROY state %p\n", c->state);
View
@@ -51,7 +51,7 @@ mop_class_create(char *name, size_t name_len)
klass->method_map = newHV();
- Copy("method_metaclass", klass->method_metaclass, 17, char);
+ Copy("mop::method", klass->method_metaclass, 17, char);
meta = mop_class_associate_metaclass( klass, name );
}
@@ -201,7 +201,7 @@ mop_class_add_method( mop_class *c, char *subname, SV *sub )
/* by fetching it rather than creating a new one, we avoid clashes */
gv = (GV *) *(hv_fetch(stash, name, s - name, TRUE ));
if (SvTYPE(gv) != SVt_PVGV) {
- gv_init(gv, stash, name, s - name, GV_ADDMULTI);
+ gv_init(gv, stash, name, s - name, GV_ADD|GV_ADDMULTI);
}
#ifndef USE_5005THREADS
@@ -230,7 +230,10 @@ mop_class_add_method( mop_class *c, char *subname, SV *sub )
}
CvGV(cv) = gv;
+ sv = newRV_inc((SV *) cv);
+ SvSetMagicSV((SV *) gv, sv);
+#if 0
sv = newRV_inc((SV *) cv);
/* Maaaybe this is no necessary if we have XS get_method_map */
if (c->methods_size == c->methods_max) {
@@ -240,10 +243,13 @@ mop_class_add_method( mop_class *c, char *subname, SV *sub )
c->methods[ c->methods_size++ ] =
mop_method_create(subname, c->name, c, sv);
- SvREFCNT_dec(GvCV(gv));
- GvCV(gv) = NULL;
- SvSetMagicSV((SV *)gv, sub);
-
+ sv_dump(gv);
+ MOP_DEBUG("GvCVu(gv) -> ");
+ sv_dump(SvRV(GvCVu(gv)));
+ if (SvOK(gv) || !SvROK(gv) || SvTYPE(SvRV(gv)) != SVt_PVCV) {
+ MOP_DEBUG("OK OK");
+ }
+#endif
MOP_DEBUG("[mop_class] add_method: adding %s to %s\n",
name, HvNAME(stash));
}
@@ -398,12 +404,14 @@ __mop_class_update_populate_method_map(const char *key, STRLEN keylen, SV *val,
cv = (CV *)SvRV(val);
c = (mop_class *) ud;
- if (!mop_package_get_code_info(cv, &cvpkg_name, &cv_name)) {
+ if (!mop_package_get_code_info(val, &cvpkg_name, &cv_name)) {
MOP_DEBUG( "No code info for %s\n", key );
/* no code info, nothing to do */
return TRUE;
}
+MOP_DEBUG("pkg = %s, name = %s\n", cvpkg_name, cv_name);
+
/* this checks to see that the subroutine is actually from our package */
if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
char *class_name_pv = HvNAME(gv_stashpv(c->name, 0));
@@ -412,7 +420,8 @@ __mop_class_update_populate_method_map(const char *key, STRLEN keylen, SV *val,
}
}
- method_slot = *hv_fetch(c->method_map, method_name, method_name_len, TRUE);
+ MOP_DEBUG("method name = %s\n", cv_name );
+ method_slot = *hv_fetch(c->method_map, cv_name, strlen(cv_name), TRUE);
if ( SvOK(method_slot) ) {
SV *const body = __mop_call0(aTHX_ method_slot, KEY_FOR(body)); /* $method_object->body() */
/* Don't need to do anything if we've already created this entry, and
@@ -423,8 +432,30 @@ __mop_class_update_populate_method_map(const char *key, STRLEN keylen, SV *val,
}
}
+ /* optimization for default mop behavior */
+ if (strEQ(c->method_metaclass, "mop::method")) {
+ mop_method *mm;
+ mop_state *st;
+ HV *hv = newHV();
+ method_object = newSV(0);
+
+ mm = mop_method_create(cv_name, cvpkg_name, c, cv);
+ sv_setsv(method_object, sv_2mortal(newRV_noinc((SV*) hv)));
+ (void)sv_bless(method_object, gv_stashpv("mop::method", TRUE));
+
+ st = mop_state_create(mm, method_object);
+
+ sv_magic((SV*)hv, NULL, '~', NULL, 0);
+ MOP_STATE_FROM_SV(method_object) = (void *) st;
+ } else {
+ MOP_DEBUG("Shouldn't come here\n");
+ }
+ hv_store(c->method_map, cv_name, strlen(cv_name), method_object, 0);
+
+/*
MOP_DEBUG( "mop_package_get_package_symbols %s -> %p\n", GvNAME(method_slot), method_object );
sv_setsv(method_slot, method_object);
+*/
#if 0
method_metaclass_name = c->method_metaclass;
View
@@ -5,16 +5,29 @@
int
mop_package_get_code_info (SV *coderef, char **pkg, char **name)
{
- if (!SvOK(coderef) || !SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
+ coderef = (CV *) coderef;
+/*
+ if (! SvOK(coderef)) {
+ MRO_DEBUG("SvOK failed on coderef");
+ return 0;
+ }
+
+ if (! SvROK(coderef)) {
+ MRO_DEBUG("SvROK failed on coderef");
+ return 0;
+ }
+ if (SvTYPE(SvRV(coderef)) != SVt_PVCV) {
+ MRO_DEBUG("SvTYPE(SvRV) failed on coderef");
return 0;
}
coderef = SvRV(coderef);
- /* sub is still being compiled */
+ * sub is still being compiled *
if (!CvGV(coderef)) {
return 0;
}
+*/
/* I think this only gets triggered with a mangled coderef, but if
we hit it without the guard, we segfault. The slightly odd return
@@ -68,11 +81,6 @@ mop_package_get_package_symbols (
char *package;
SV *fq;
- if (! SvOK(gv)) {
- MOP_DEBUG( "couldn't get proper SV for %s \n", GvNAME(gv));
- continue;
- }
-
MOP_DEBUG( "Checking val = %s\n", GvNAME(gv));
switch( SvTYPE(gv) ) {
@@ -115,11 +123,10 @@ mop_package_get_package_symbols (
continue;
}
-MOP_DEBUG("SvROK(sv) -> %s\n", SvROK(sv) ? "YES" : "NO");
-MOP_DEBUG("SvOK(sv) -> %s\n", SvOK(sv) ? "YES" : "NO");
-
if (sv) {
const char *key = HePV(he, keylen);
+
+MOP_DEBUG("Handing SV to callback");
if (!cb(key, keylen, sv, ud)) {
return;
}
View
@@ -19,11 +19,13 @@ use_ok("mop");
{
my $class_meta = Test::mop->meta;
+ sub Test::mop::foo0 { 1 };
-# $class_meta->superclasses("Foo");
-# is_deeply( \@Test::mop::ISA, [ "Foo" ] );
+ $class_meta->superclasses("Foo");
+ is_deeply( \@Test::mop::ISA, [ "Foo" ] );
$class_meta->add_method("foo1", sub { 1 + 1 });
$class_meta->add_method("foo2", sub { 2 + 2 });
+ is( Test::mop->foo0(), 1 );
is( Test::mop->foo1(), 2 );
is( Test::mop->foo2(), 4 );

0 comments on commit 42b74c3

Please sign in to comment.