From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 24 Jan 2006 18:48:42 +0000 (+0000)
Subject: method stuff worked out
X-Git-Tag: 0_02~24
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=60d90bbc61f4f516de84b1e2a16d5f2a451e65dc;p=gitmo%2FClass-MOP.git

method stuff worked out
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 52a45b2..fc33b54 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -160,9 +160,6 @@ in which method dispatch will be done.
 
 =head3 Methods
 
-B<NOTE>: These methods makes every attempt to ignore subroutines
-which have been exported by other packages into this one.
-
 =over 4
 
 =item B<add_method ($method_name, $method)>
@@ -181,6 +178,25 @@ This just provides a simple way to check if the Class implements
 a specific C<$method_name>. It will I<not> however, attempt to check 
 if the class inherits the method.
 
+This will correctly ignore functions imported from other packages, 
+and will correctly handle functions defined outside of the package 
+that use a fully qualified name (C<sub Package::name { ... }>). It 
+will B<not> handle anon functions stored in the package using symbol 
+tables, unless the anon function is first named using B<Sub::Name>.
+For instance, this will not return true with C<has_method>:
+
+  *{$pkg . '::' . $name} = sub { ... };
+
+However, this will DWIM:
+
+  my $full_name = $pkg . '::' . $name;
+  my $sub = sub { ... };
+  Sub::Name::subname($full_name, $sub);
+  *{$full_name} = $sub;
+
+B<NOTE:> this code need not be so tedious, it is only this way to 
+illustrate my point more clearly.
+
 =item B<get_method ($method_name)>
 
 This will return a CODE reference of the specified C<$method_name>, 
diff --git a/t/003_methods.t b/t/003_methods.t
index f06f70b..39db0f9 100644
--- a/t/003_methods.t
+++ b/t/003_methods.t
@@ -19,6 +19,20 @@ BEGIN {
     
     # define a sub in package
     sub bar { 'Foo::bar' } 
+    *baz = \&bar;
+    
+    # We hateses the "used only once" warnings
+    { my $temp = \&Foo::baz }
+
+    package main;
+    
+    sub Foo::blah { $_[0]->Foo::baz() }
+    
+    {
+        no strict 'refs';
+        *{'Foo::bling'} = sub { '$$Bling$$' };
+        *{'Foo::bang'} = Sub::Name::subname 'Foo::bang' => sub { '!BANG!' };        
+    }
 }
 
 my $Foo = Foo->meta;
@@ -32,7 +46,13 @@ lives_ok {
 ok($Foo->has_method('foo'), '... Foo->has_method(foo) (defined with Sub::Name)');
 ok(!$Foo->has_method('blessed'), '... !Foo->has_method(blessed) (imported into Foo)');
 ok($Foo->has_method('bar'), '... Foo->has_method(bar) (defined in Foo)');
+ok($Foo->has_method('baz'), '... Foo->has_method(baz) (typeglob aliased within Foo)');
+ok($Foo->has_method('blah'), '... Foo->has_method(blah) (defined in main:: using fully qualified package name)');
+ok(!$Foo->has_method('bling'), '... !Foo->has_method(bling) (defined in main:: using symbol tables (no Sub::Name))');
+ok($Foo->has_method('bang'), '... Foo->has_method(bang) (defined in main:: using symbol tables and Sub::Name)');
 
 is($Foo->get_method('foo'), $foo, '... Foo->get_method(foo) == \&foo');
 
-is(Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"');
\ No newline at end of file
+is(Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"');
+is(Foo->bar(), 'Foo::bar', '... Foo->bar() returns "Foo::bar"');
+is(Foo->baz(), 'Foo::bar', '... Foo->baz() returns "Foo::bar" (because it is aliased to &bar)');