From: Dave Rolsky Date: Thu, 11 Sep 2008 16:24:44 +0000 (+0000) Subject: Actually implement and test having add_method clone methods. It will X-Git-Tag: 0.66~3^2~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7d682ca2399e3d09eb4105febacd4baa5f6cd2a1;p=gitmo%2FClass-MOP.git Actually implement and test having add_method clone methods. It will now clone the method if just the package name of the object differs from the class. --- diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 56e3e94..d76b724 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -610,9 +610,7 @@ sub add_method { my $body; if (blessed($method)) { $body = $method->body; - if ($method->package_name ne $self->name && - $method->name ne $method_name) { - warn "CLONING method\n"; + if ($method->package_name ne $self->name) { $method = $method->clone( package_name => $self->name, name => $method_name diff --git a/t/003_methods.t b/t/003_methods.t index 204f882..d21e7be 100644 --- a/t/003_methods.t +++ b/t/003_methods.t @@ -17,10 +17,9 @@ BEGIN { } } -BEGIN { - use_ok('Class::MOP'); - use_ok('Class::MOP::Class'); -} +use Class::MOP; +use Class::MOP::Class; +use Class::MOP::Method; { # This package tries to test &has_method # as exhaustively as possible. More corner @@ -246,4 +245,15 @@ is_deeply( ], '... got the right list of applicable methods for Bar'); +my $method = Class::MOP::Method->wrap( + name => 'objecty', + package_name => 'Whatever', + body => sub {q{I am an object, and I feel an object's pain}}, +); + +Bar->meta->add_method( $method->name, $method ); + +my $new_method = Bar->meta->get_method('objecty'); +isnt( $method, $new_method, 'add_method clones method objects as they are added' ); +is( $new_method->original_method, $method, '... the cloned method has the correct original method' );