From: gfx <gfuji@cpan.org>
Date: Thu, 3 Dec 2009 04:11:24 +0000 (+0900)
Subject: Add meta() method to method metaclasses
X-Git-Tag: 0.40_09~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=3821b191b0493223e0f67b05ad351e3753fcfc66;hp=34c8209c4eac1f2f710e1523ef3b3a248f7a08c8

Add meta() method to method metaclasses
---

diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm
index 2ca2faa..810fbc0 100755
--- a/lib/Mouse/Meta/Method/Accessor.pm
+++ b/lib/Mouse/Meta/Method/Accessor.pm
@@ -1,5 +1,5 @@
 package Mouse::Meta::Method::Accessor;
-use Mouse::Util; # enables strict and warnings
+use Mouse::Util qw(:meta); # enables strict and warnings
 
 sub _inline_slot{
     my(undef, $self_var, $attr_name) = @_;
diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm
index e2a3b7c..5e75f5d 100644
--- a/lib/Mouse/Meta/Method/Constructor.pm
+++ b/lib/Mouse/Meta/Method/Constructor.pm
@@ -1,5 +1,5 @@
 package Mouse::Meta::Method::Constructor;
-use Mouse::Util; # enables strict and warnings
+use Mouse::Util qw(:meta); # enables strict and warnings
 
 sub _inline_slot{
     my(undef, $self_var, $attr_name) = @_;
diff --git a/lib/Mouse/Meta/Method/Delegation.pm b/lib/Mouse/Meta/Method/Delegation.pm
index fcb0af4..7d429a7 100644
--- a/lib/Mouse/Meta/Method/Delegation.pm
+++ b/lib/Mouse/Meta/Method/Delegation.pm
@@ -1,6 +1,6 @@
 package Mouse::Meta::Method::Delegation;
-use Mouse::Util; # enables strict and warnings
-use Scalar::Util qw(blessed);
+use Mouse::Util qw(:meta); # enables strict and warnings
+use Scalar::Util;
 
 sub _generate_delegation{
     my (undef, $attribute, $metaclass, $reader, $handle_name, $method_to_call) = @_;
@@ -9,9 +9,9 @@ sub _generate_delegation{
         my $instance = shift;
         my $proxy    = $instance->$reader();
 
-        my $error = !defined($proxy)                ? ' is not defined'
-                  : ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')}
-                                                    : undef;
+        my $error = !defined($proxy)                              ? ' is not defined'
+                  : ref($proxy) && !Scalar::Util::blessed($proxy) ? qq{ is not an object (got '$proxy')}
+                                                                  : undef;
         if ($error) {
             $instance->meta->throw_error(
                 "Cannot delegate $handle_name to $method_to_call because "
diff --git a/lib/Mouse/Meta/Method/Destructor.pm b/lib/Mouse/Meta/Method/Destructor.pm
index 3ce7d27..3aa2e69 100644
--- a/lib/Mouse/Meta/Method/Destructor.pm
+++ b/lib/Mouse/Meta/Method/Destructor.pm
@@ -1,5 +1,5 @@
 package Mouse::Meta::Method::Destructor;
-use Mouse::Util; # enables strict and warnings
+use Mouse::Util qw(:meta); # enables strict and warnings
 
 sub _empty_DESTROY{ }
 
diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index 783f24a..5af9ca8 100644
--- a/lib/Mouse/Util.pm
+++ b/lib/Mouse/Util.pm
@@ -54,6 +54,7 @@ BEGIN{
             XSLoader::load('Mouse', $VERSION);
             Mouse::Util->import({ into => 'Mouse::Meta::Method::Constructor::XS' }, ':meta');
             Mouse::Util->import({ into => 'Mouse::Meta::Method::Destructor::XS'  }, ':meta');
+            Mouse::Util->import({ into => 'Mouse::Meta::Method::Accessor::XS'    }, ':meta');
             return 1;
         };
         #warn $@ if $@;
diff --git a/t/001_mouse/063-meta-of-metaclasses.t b/t/001_mouse/063-meta-of-metaclasses.t
index 9aa2e3b..8ef6294 100644
--- a/t/001_mouse/063-meta-of-metaclasses.t
+++ b/t/001_mouse/063-meta-of-metaclasses.t
@@ -2,17 +2,41 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use Test::More tests => 10;
 
-use Mouse ();
+{
+    package Class;
+    use Mouse;
 
-can_ok('Mouse::Meta::Class', 'meta');
-can_ok('Mouse::Meta::Role', 'meta');
+    has foo => (is => 'rw');
 
-my $meta = Mouse::Meta::Class->meta;
-can_ok($meta->constructor_class, 'meta');
-can_ok($meta->destructor_class, 'meta');
-can_ok($meta->attribute_metaclass, 'meta');
+    __PACKAGE__->meta->make_immutable; # ensure metaclasses loaded
 
-can_ok($meta->get_method('is_anon_class'), 'meta');
+    package Role;
+    use Mouse::Role;
 
+    sub bar {}
+}
+
+{
+    my $metaclass = Class->meta;
+
+    can_ok($metaclass, 'meta');
+
+    can_ok($metaclass->constructor_class, 'meta');
+    can_ok($metaclass->destructor_class, 'meta');
+    can_ok($metaclass->attribute_metaclass, 'meta');
+
+    can_ok($metaclass->get_method('foo'),   'meta');
+    can_ok($metaclass->get_attribute('foo'), 'meta');
+    can_ok($metaclass->get_attribute('foo')->accessor_metaclass, 'meta');
+    can_ok($metaclass->get_attribute('foo')->delegation_metaclass, 'meta');
+}
+
+{
+    my $metarole = Class->meta;
+
+    can_ok($metarole, 'meta');
+
+    can_ok($metarole->get_method('foo'),   'meta');
+}