version.
);
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:
$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 {
'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,
'package' => $package_name,
%options,
});
-
Class::MOP::store_metaclass_by_name($package_name, $meta);
return $meta;
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
# 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);
(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 }
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<Class::MOP::Method> objects.
-
=item B<< $metapackage->get_method_list >>
This will return a list of method I<names> for all methods defined in
use strict;
use warnings;
-use Test::More tests => 70;
+use Test::More tests => 69;
use Test::Exception;
use Scalar::Util qw/reftype/;
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(
_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
);
my @class_mop_package_attributes = (
'package',
'namespace',
- 'methods',
'method_metaclass',
'wrapped_method_metaclass',
);
use strict;
use warnings;
-use Test::More tests => 99;
+use Test::More tests => 95;
use Test::Exception;
use Scalar::Util;
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');
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');
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');
}
{
ok( $meta->$_ , "... ${_} works")
for qw(get_meta_instance get_all_attributes
- class_precedence_list get_method_map );
+ class_precedence_list );
}
{
ok( $meta->$_ , "... ${_} works")
for qw(get_meta_instance get_all_attributes
- class_precedence_list get_method_map );
+ class_precedence_list );
};
ok( $meta->$_ , "... ${_} works")
for qw(get_meta_instance get_all_attributes
- class_precedence_list get_method_map );
+ class_precedence_list );
}
{
+++ /dev/null
-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' );
-}
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");
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);
projects / gitmo/Class-MOP.git / commitdiff