From: Dave Rolsky Date: Wed, 26 Aug 2009 17:29:00 +0000 (-0500) Subject: Make get_method_map private (as _full_method_map) and deprecate the public X-Git-Tag: 0.93~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=241646a3d4649202bf4abdb6abe1b24c953f417f;p=gitmo%2FClass-MOP.git Make get_method_map private (as _full_method_map) and deprecate the public version. --- diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index b8437ac..1d97d40 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -207,18 +207,6 @@ Class::MOP::Package->meta->add_attribute( ); Class::MOP::Package->meta->add_attribute( - Class::MOP::Attribute->new('methods' => ( - reader => { - # NOTE: - # we just alias the original method - # rather than re-produce it here - 'get_method_map' => \&Class::MOP::Package::get_method_map - }, - default => sub { {} } - )) -); - -Class::MOP::Package->meta->add_attribute( Class::MOP::Attribute->new('method_metaclass' => ( reader => { # NOTE: diff --git a/lib/Class/MOP/Class/Immutable/Trait.pm b/lib/Class/MOP/Class/Immutable/Trait.pm index 2bf6074..c6e9da7 100644 --- a/lib/Class/MOP/Class/Immutable/Trait.pm +++ b/lib/Class/MOP/Class/Immutable/Trait.pm @@ -74,10 +74,10 @@ sub get_meta_instance { $self->{__immutable}{get_meta_instance} ||= $self->$orig; } -sub get_method_map { +sub _get_method_map { my $orig = shift; my $self = shift; - $self->{__immutable}{get_method_map} ||= $self->$orig; + $self->{__immutable}{_get_method_map} ||= $self->$orig; } sub add_package_symbol { diff --git a/lib/Class/MOP/Deprecated.pm b/lib/Class/MOP/Deprecated.pm index 38b9ee6..b36d687 100644 --- a/lib/Class/MOP/Deprecated.pm +++ b/lib/Class/MOP/Deprecated.pm @@ -15,6 +15,8 @@ my %DeprecatedAt = ( 'Class::MOP::subname' => 0.93, 'Class::MOP::in_global_destruction' => 0.93, + 'Class::MOP::Package::get_method_map' => 0.93, + 'Class::MOP::Class::construct_class_instance' => 0.93, 'Class::MOP::Class::check_metaclass_compatibility' => 0.93, 'Class::MOP::Class::create_meta_instance' => 0.93, diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 370f158..fd745db 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -34,7 +34,6 @@ sub initialize { 'package' => $package_name, %options, }); - Class::MOP::store_metaclass_by_name($package_name, $meta); return $meta; @@ -106,7 +105,11 @@ sub namespace { sub method_metaclass { $_[0]->{'method_metaclass'} } sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'} } -sub _method_map { $_[0]->{'methods'} } +# This doesn't always get initialized in a constructor because there is a +# weird object construction path for subclasses of Class::MOP::Class. At one +# point, this always got initialized by calling into the XS code first, but +# that is no longer guaranteed to happen. +sub _method_map { $_[0]->{'methods'} ||= {} } # utility methods @@ -328,7 +331,7 @@ sub add_method { # The method object won't be created until required. $body = $method; } - + Carp::cluck('wtf') unless defined $self->_method_map; $self->_method_map->{$method_name} = $method; my ( $current_package, $current_name ) = Class::MOP::get_code_info($body); @@ -399,7 +402,7 @@ sub remove_method { (defined $method_name && $method_name) || confess "You must define a method name"; - my $removed_method = delete $self->get_method_map->{$method_name}; + my $removed_method = delete $self->_full_method_map->{$method_name}; $self->remove_package_symbol( { sigil => '&', type => 'CODE', name => $method_name } @@ -541,12 +544,6 @@ Returns a boolean indicating whether or not the class defines the named method. It does not include methods inherited from parent classes. -=item B<< $metapackage->get_method_map >> - -Returns a hash reference representing the methods defined in this -class. The keys are method names and the values are -L objects. - =item B<< $metapackage->get_method_list >> This will return a list of method I for all methods defined in diff --git a/t/003_methods.t b/t/003_methods.t index 1eaa655..ddbd7ec 100644 --- a/t/003_methods.t +++ b/t/003_methods.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 70; +use Test::More tests => 69; use Test::Exception; use Scalar::Util qw/reftype/; @@ -207,7 +207,6 @@ is_deeply( is( $Foo->remove_method('foo')->body, $foo, '... removed the foo method' ); ok( !$Foo->has_method('foo'), '... !Foo->has_method(foo) we just removed it' ); -ok( !$Foo->get_method_map->{foo}, 'foo is not in the method map' ); dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there'; is_deeply( diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index 0c45fd2..7485f55 100644 --- a/t/010_self_introspection.t +++ b/t/010_self_introspection.t @@ -39,7 +39,7 @@ my @class_mop_package_methods = qw( _method_map _code_is_mine has_method get_method add_method remove_method wrap_method_body - get_method_list get_method_map + get_method_list _full_method_map _deconstruct_variable_name ); @@ -162,7 +162,6 @@ foreach my $non_method_name (qw( my @class_mop_package_attributes = ( 'package', 'namespace', - 'methods', 'method_metaclass', 'wrapped_method_metaclass', ); diff --git a/t/073_make_mutable.t b/t/073_make_mutable.t index d15626e..59d3e4b 100644 --- a/t/073_make_mutable.t +++ b/t/073_make_mutable.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 99; +use Test::More tests => 95; use Test::Exception; use Scalar::Util; @@ -49,7 +49,7 @@ use Class::MOP; ok(!$meta->is_mutable, '... our class is no longer mutable'); ok($meta->is_immutable, '... our class is now immutable'); ok(!$meta->make_immutable, '... make immutable now returns nothing'); - ok($meta->get_method_map->{new}, '... inlined constructor created'); + ok($meta->get_method('new'), '... inlined constructor created'); ok($meta->has_method('new'), '... inlined constructor created for sure'); is_deeply([ map { $_->name } $meta->_inlined_methods ], [ 'new' ], '... really, i mean it'); @@ -57,8 +57,8 @@ use Class::MOP; ok($meta->is_mutable, '... our class is mutable'); ok(!$meta->is_immutable, '... our class is not immutable'); ok(!$meta->make_mutable, '... make mutable now returns nothing'); - ok(!$meta->get_method_map->{new}, '... inlined constructor removed'); - ok(!$meta->has_method('new'), '... inlined constructor removed for sure'); + ok(!$meta->get_method('new'), '... inlined constructor created'); + ok(!$meta->has_method('new'), '... inlined constructor removed for sure'); my %new_keys = map { $_ => 1 } grep { !/^_/ } keys %$meta; is_deeply(\%orig_keys, \%new_keys, '... no extraneous hashkeys'); @@ -86,10 +86,10 @@ use Class::MOP; ok( $meta->$_ , "... ${_} works") for qw(get_meta_instance get_all_attributes - class_precedence_list get_method_map ); + class_precedence_list ); lives_ok {$meta->make_immutable; } '... changed Baz to be immutable again'; - ok($meta->get_method_map->{new}, '... inlined constructor recreated'); + ok($meta->get_method('new'), '... inlined constructor recreated'); } { @@ -115,7 +115,7 @@ use Class::MOP; ok( $meta->$_ , "... ${_} works") for qw(get_meta_instance get_all_attributes - class_precedence_list get_method_map ); + class_precedence_list ); } { @@ -175,7 +175,7 @@ use Class::MOP; ok( $meta->$_ , "... ${_} works") for qw(get_meta_instance get_all_attributes - class_precedence_list get_method_map ); + class_precedence_list ); }; @@ -208,7 +208,7 @@ use Class::MOP; ok( $meta->$_ , "... ${_} works") for qw(get_meta_instance get_all_attributes - class_precedence_list get_method_map ); + class_precedence_list ); } { diff --git a/t/084_get_method_map.t b/t/084_get_method_map.t deleted file mode 100644 index d85f6e6..0000000 --- a/t/084_get_method_map.t +++ /dev/null @@ -1,50 +0,0 @@ -use strict; -use warnings; - -use Test::More tests => 11; - - -{ - package Foo; - - use metaclass; - - sub foo { } -} - -{ - my $map = Foo->meta->get_method_map; - - is( scalar keys %{$map}, 2, - 'method map for Foo has two key' ); - ok( $map->{foo}, '... has a foo method in the map' ); - ok( $map->{meta}, '... has a meta method in the map' ); -} - - -Foo->meta->add_method( bar => sub { } ); - -{ - my $map = Foo->meta->get_method_map; - - is( scalar keys %{$map}, 3, - 'method map for Foo has three keys' ); - ok( $map->{foo}, '... has a foo method in the map' ); - ok( $map->{bar}, '... has a bar method in the map' ); - ok( $map->{meta}, '... has a meta method in the map' ); -} - -# Tests a bug where after a metaclass object was recreated, methods -# added via add_method were not showing up in the map, but only with -# the non-XS version of the code. -Class::MOP::remove_metaclass_by_name('Foo'); - -{ - my $map = Foo->meta->get_method_map; - - is( scalar keys %{$map}, 3, - 'method map for Foo has three keys' ); - ok( $map->{foo}, '... has a foo method in the map' ); - ok( $map->{bar}, '... has a bar method in the map' ); - ok( $map->{meta}, '... has a meta method in the map' ); -} diff --git a/t/307_null_stash.t b/t/307_null_stash.t index 5b018ed..3245287 100644 --- a/t/307_null_stash.t +++ b/t/307_null_stash.t @@ -4,5 +4,7 @@ use warnings; use Test::More tests => 1; use Class::MOP; -my $map = Class::MOP::Class->initialize('Non::Existent::Package')->get_method_map; +my $non = Class::MOP::Class->initialize('Non::Existent::Package'); +$non->get_method('foo'); + pass("empty stashes don't segfault"); diff --git a/xs/Package.xs b/xs/Package.xs index 675e894..1172483 100644 --- a/xs/Package.xs +++ b/xs/Package.xs @@ -121,7 +121,7 @@ get_all_package_symbols(self, filter=TYPE_FILTER_NONE) PUSHs(sv_2mortal(newRV_noinc((SV *)symbols))); void -get_method_map(self) +_full_method_map(self) SV *self PREINIT: HV *const obj = (HV *)SvRV(self);