From: gfx <gfuji@cpan.org>
Date: Wed, 10 Mar 2010 08:00:19 +0000 (+0900)
Subject: Make Meta::Method comparable like Class::MOP::Method
X-Git-Tag: 0.50_08~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=81eaf8ebca69d1b887524fd5a5fcee287c4e87e2

Make Meta::Method comparable like Class::MOP::Method
---

diff --git a/lib/Mouse/Meta/Method.pm b/lib/Mouse/Meta/Method.pm
index 595355b..0f125dd 100755
--- a/lib/Mouse/Meta/Method.pm
+++ b/lib/Mouse/Meta/Method.pm
@@ -1,7 +1,10 @@
 package Mouse::Meta::Method;
 use Mouse::Util qw(:meta); # enables strict and warnings
+use Scalar::Util ();
 
 use overload
+    '=='  => '_equal',
+    'eq'  => '_equal',
     '&{}' => sub{ $_[0]->body },
     fallback => 1,
 ;
@@ -32,6 +35,16 @@ sub fully_qualified_name {
     return $self->package_name . '::' . $self->name;
 }
 
+# for Moose compat
+sub _equal {
+    my($l, $r) = @_;
+
+    return Scalar::Util::blessed($r)
+            && $l->body         == $r->body
+            && $l->name         eq $r->name
+            && $l->package_name eq $r->package_name;
+}
+
 1;
 __END__
 
diff --git a/t/001_mouse/100-meta-class.t b/t/001_mouse/100-meta-class.t
index 15da58c..934b1b4 100644
--- a/t/001_mouse/100-meta-class.t
+++ b/t/001_mouse/100-meta-class.t
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 26;
+use Test::More;
 use Test::Exception;
 {
     package Class;
@@ -18,6 +18,8 @@ use Test::Exception;
     sub stub;
     sub stub_with_attr :method;
 
+    sub king { 'king' }
+
     no Mouse;
 }
 {
@@ -60,13 +62,23 @@ ok(!$meta->has_attribute('nonexistent_attribute'));
 
 ok($meta->has_method('pawn'));
 lives_and{
-    ok($meta->get_method('pawn'));
-    is($meta->get_method('pawn')->name, 'pawn');
-    is($meta->get_method('pawn')->package_name, 'Class');
+    my $pawn = $meta->get_method('pawn');
+    ok($pawn);
+    is($pawn->name, 'pawn');
+    is($pawn->package_name, 'Class');
+    is($pawn->fully_qualified_name, 'Class::pawn');
+
+    is $pawn, $pawn;
+
+    my $king = $meta->get_method('king');
+    isnt $pawn, $king;
+
+    $meta->add_method(king => sub{ 'fool' });
+    isnt $king, $meta->get_method('king');
 };
 
 is( join(' ', sort $meta->get_method_list),
-    join(' ', sort qw(meta pawn has_pawn MY_CONST stub stub_with_attr))
+    join(' ', sort qw(meta pawn king has_pawn MY_CONST stub stub_with_attr))
 );
 
 eval q{
@@ -106,7 +118,9 @@ is( join(' ', sort map{ $_->fully_qualified_name } grep{ $_->package_name ne 'Mo
     join(' ', sort qw(
         Child::bishop Child::child_method Child::meta
 
-        Class::MY_CONST Class::has_pawn Class::pawn Class::stub Class::stub_with_attr
+        Class::MY_CONST Class::has_pawn Class::pawn Class::king Class::stub Class::stub_with_attr
     ))
 );
 
+done_testing;
+