From: Dave Rolsky <autarch@urth.org>
Date: Mon, 1 Sep 2008 14:57:08 +0000 (+0000)
Subject: Fix XS so that Class::MOP::Method accessors blow up if called as class methods.
X-Git-Tag: 0.65~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=da88f307a9f54e4fef38bf1d7354cdb4d137c451;p=gitmo%2FClass-MOP.git

Fix XS so that Class::MOP::Method accessors blow up if called as class methods.

Restore name() XS accessor and make pure Perl version do the same thing.

Add a package_name() XS accessor and make pure Perl version do the same thing.
---

diff --git a/MOP.xs b/MOP.xs
index 6230e45..942b378 100644
--- a/MOP.xs
+++ b/MOP.xs
@@ -13,6 +13,9 @@ U32 hash_name;
 SV *key_package;
 U32 hash_package;
 
+SV *key_package_name;
+U32 hash_package_name;
+
 SV *key_body;
 U32 hash_body;
 
@@ -29,10 +32,12 @@ BOOT:
     key_name = newSVpvs("name");
     key_body = newSVpvs("body");
     key_package = newSVpvs("package");
+    key_package_name = newSVpvs("package_name");
 
     PERL_HASH(hash_name, "name", 4);
     PERL_HASH(hash_body, "body", 4);
     PERL_HASH(hash_package, "package", 7);
+    PERL_HASH(hash_package_name, "package_name", 12);
 
 
 PROTOTYPES: ENABLE
@@ -185,12 +190,46 @@ name(self)
 MODULE = Class::MOP   PACKAGE = Class::MOP::Method
 
 SV *
+name(self)
+    SV *self
+    PREINIT:
+        register HE *he;
+    PPCODE:
+        if (! SvROK(self)) {
+            die("Cannot call name as a class method");
+        }
+
+        if (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name))
+            XPUSHs(HeVAL(he));
+        else
+            ST(0) = &PL_sv_undef;
+
+SV *
+package_name(self)
+    SV *self
+    PREINIT:
+        register HE *he;
+    PPCODE:
+        if (! SvROK(self)) {
+            die("Cannot call package_name as a class method");
+        }
+
+        if (he = hv_fetch_ent((HV *)SvRV(self), key_package_name, 0, hash_package_name))
+            XPUSHs(HeVAL(he));
+        else
+            ST(0) = &PL_sv_undef;
+
+SV *
 body(self)
     SV *self
     PREINIT:
         register HE *he;
     PPCODE:
-        if (SvROK(self) && (he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body)))
+        if (! SvROK(self)) {
+            die("Cannot call body as a class method");
+        }
+
+        if (he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body))
             XPUSHs(HeVAL(he));
         else
             ST(0) = &PL_sv_undef;
diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index b58b7e6..2c645b9 100644
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -79,15 +79,9 @@ sub detach_from_class {
     delete $self->{associated_metaclass};
 }
 
-sub package_name {
-    my $self = shift;
-    $self->{'package_name'} ||= (Class::MOP::get_code_info($self->body))[0];
-}
+sub package_name { (shift)->{'package_name'} }
 
-sub name {
-    my $self = shift;
-    $self->{'name'} ||= (Class::MOP::get_code_info($self->body))[1];
-}
+sub name { (shift)->{'name'} }
 
 sub fully_qualified_name {
     my $code = shift;
diff --git a/t/030_method.t b/t/030_method.t
index 42ed31d..b481a5c 100644
--- a/t/030_method.t
+++ b/t/030_method.t
@@ -3,13 +3,12 @@
 use strict;
 use warnings;
 
-use Test::More tests => 28;
+use Test::More tests => 27;
 use Test::Exception;
 
-BEGIN {
-    use_ok('Class::MOP');    
-    use_ok('Class::MOP::Method');
-}
+use Class::MOP;
+use Class::MOP::Method;
+
 
 my $method = Class::MOP::Method->wrap(
     sub { 1 },
@@ -26,9 +25,10 @@ dies_ok { Class::MOP::Method->wrap } q{... can't call wrap() without some code};
 dies_ok { Class::MOP::Method->wrap([]) } q{... can't call wrap() without some code};
 dies_ok { Class::MOP::Method->wrap(bless {} => 'Fail') } q{... can't call wrap() without some code};
 
-dies_ok { Class::MOP::Method->name } q{... can't call name() with a class};
-dies_ok { Class::MOP::Method->package_name } q{... can't call package_name() with a class};
-dies_ok { Class::MOP::Method->fully_qualified_name } q{... can't call fully_qualified_name() with a class};
+dies_ok { Class::MOP::Method->name } q{... can't call name() as a class method};
+dies_ok { Class::MOP::Method->body } q{... can't call body() as a class method};
+dies_ok { Class::MOP::Method->package_name } q{... can't call package_name() as a class method};
+dies_ok { Class::MOP::Method->fully_qualified_name } q{... can't call fully_qualified_name() as a class method};
 
 my $meta = Class::MOP::Method->meta;
 isa_ok($meta, 'Class::MOP::Class');