From: Dave Rolsky Date: Thu, 11 Sep 2008 15:30:13 +0000 (+0000) Subject: Revert the last few commits related to deprecating alias_method, which X-Git-Tag: 0.66~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0310d95d482349208449c86f91b5aa661d6411d4;p=gitmo%2FClass-MOP.git Revert the last few commits related to deprecating alias_method, which will now be done on a branch first. --- diff --git a/Changes b/Changes index bd8ba74..35d04aa 100644 --- a/Changes +++ b/Changes @@ -6,11 +6,6 @@ Revision history for Perl extension Class-MOP. XS, which should help us catch skew between the XS/pure Perl code (Dave Rolsky) - * Class::MOP::Class - - The alias_method method has been deprecated. It now simply - calls add_method instead. This means there is no distinction - between aliased methods and "real" methods. (Dave Rolsky) - 0.65 Mon September 1, 2008 For those not following the series of dev releases, the changes from 0.64 from 0.65 can mostly be summed up as a lot performance diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index e173d1c..70d8a39 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -31,7 +31,7 @@ BEGIN { *check_package_cache_flag = \&mro::get_pkg_gen; } -our $VERSION = '0.66'; +our $VERSION = '0.65'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index c8962f2..9136f86 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -710,9 +710,19 @@ sub add_method { } sub alias_method { - my $self = shift; + my ($self, $method_name, $method) = @_; + (defined $method_name && $method_name) + || confess "You must define a method name"; + + my $body = (blessed($method) ? $method->body : $method); + ('CODE' eq ref($body)) + || confess "Your code block must be a CODE reference"; + + $self->add_package_symbol( + { sigil => '&', type => 'CODE', name => $method_name } => $body + ); - $self->add_method(@_); + $self->update_package_cache_flag; # the method map will not list aliased methods } sub has_method { @@ -1453,13 +1463,8 @@ Wrap a code ref (C<$attrs{body>) with C. =item B -This will take a C<$method_name> and CODE reference or meta method -objectand install it into the class's package. - -You are strongly encouraged to pass a meta method object instead of a -code reference. If you do so, that object gets stored as part of the -class's method map, providing more useful information about the method -for introspection. +This will take a C<$method_name> and CODE reference to that +C<$method> and install it into the class's package. B: This does absolutely nothing special to C<$method> @@ -1467,6 +1472,16 @@ other than use B to make sure it is tagged with the correct name, and therefore show up correctly in stack traces and such. +=item B + +This will take a C<$method_name> and CODE reference to that +C<$method> and alias the method into the class's package. + +B: +Unlike C, this will B try to name the +C<$method> using B, it only aliases the method in +the class's package. + =item B This just provides a simple way to check if the class implements @@ -1554,11 +1569,6 @@ This will return the first method to match a given C<$method_name> in the superclasses, this is basically equivalent to calling C, but it can be dispatched at runtime. -=item B - -B: This method is now deprecated. Just use C -instead. - =back =head2 Method Modifiers diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index 37af5a1..fb90eda 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -84,8 +84,8 @@ sub package_name { (shift)->{'package_name'} } sub name { (shift)->{'name'} } sub fully_qualified_name { - my $self = shift; - $self->package_name . '::' . $self->name; + my $code = shift; + $code->package_name . '::' . $code->name; } # NOTE: diff --git a/t/003_methods.t b/t/003_methods.t index 204f882..6b39b0a 100644 --- a/t/003_methods.t +++ b/t/003_methods.t @@ -155,7 +155,7 @@ for my $method_name (qw/ $Foo->alias_method('alias_me' => Foo::Aliasing->meta->get_method('alias_me')); -ok($Foo->has_method('alias_me'), '... Foo->has_method(alias_me) (aliased from Foo::Aliasing)'); +ok(!$Foo->has_method('alias_me'), '... !Foo->has_method(alias_me) (aliased from Foo::Aliasing)'); ok(defined &Foo::alias_me, '... Foo does have a symbol table slow for alias_me though'); ok(!$Foo->has_method('blessed'), '... !Foo->has_method(blessed) (imported into Foo)'); @@ -166,7 +166,7 @@ is($Foo->get_method('not_a_real_method'), undef, '... Foo->get_method(not_a_real is_deeply( [ sort $Foo->get_method_list ], - [ qw(FOO_CONSTANT alias_me baaz bang bar baz blah evaled_foo floob foo) ], + [ qw(FOO_CONSTANT baaz bang bar baz blah evaled_foo floob foo) ], '... got the right method list for Foo'); is_deeply( @@ -174,7 +174,6 @@ is_deeply( [ map { $Foo->get_method($_) } qw( FOO_CONSTANT - alias_me baaz bang bar @@ -193,7 +192,7 @@ dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there'; is_deeply( [ sort $Foo->get_method_list ], - [ qw(FOO_CONSTANT alias_me baaz bang bar baz blah evaled_foo floob) ], + [ qw(FOO_CONSTANT baaz bang bar baz blah evaled_foo floob) ], '... got the right method list for Foo'); @@ -231,7 +230,6 @@ is_deeply( [ sort { $a->name cmp $b->name } $Bar->get_all_methods() ], [ $Foo->get_method('FOO_CONSTANT'), - $Foo->get_method('alias_me'), $Foo->get_method('baaz'), $Foo->get_method('bang'), $Bar->get_method('bar'), diff --git a/t/073_make_mutable.t b/t/073_make_mutable.t index 0fec326..8880f27 100644 --- a/t/073_make_mutable.t +++ b/t/073_make_mutable.t @@ -71,10 +71,10 @@ BEGIN { ok(! $meta->has_method('zxy') ,'... we dont have the aliased method yet'); ok( $meta->alias_method('zxy',sub{'xxx'}),'... aliased method'); - ok( $meta->has_method('zxy') ,'... the aliased method does register'); + ok(! $meta->has_method('zxy') ,'... the aliased method does not register (correctly)'); is( Baz->zxy, 'xxx', '... method zxy works'); ok( $meta->remove_method('xyz'), '... removed method'); - ok( $meta->remove_method('zxy'), '... removed aliased method'); + ok(! $meta->remove_method('zxy'), '... removed aliased method'); ok($meta->add_attribute('fickle', accessor => 'fickle'), '... added attribute'); ok(Baz->can('fickle'), '... Baz can fickle'); @@ -169,7 +169,7 @@ BEGIN { ok( $meta->alias_method('zxy',sub{'xxx'}),'... aliased method'); is( $instance->zxy, 'xxx', '... method zxy works'); ok( $meta->remove_method('xyz'), '... removed method'); - ok( $meta->remove_method('zxy'), '... removed aliased method'); + ok( !$meta->remove_method('zxy'), '... removed aliased method'); ok($meta->add_attribute('fickle', accessor => 'fickle'), '... added attribute'); ok($instance->can('fickle'), '... instance can fickle');