improvement the compatibility with Moose.

diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index 642f738..3a0a529 100644 (file)
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -64,6 +64,7 @@ sub add_method {
     my $pkg = $self->name;
 
     no strict 'refs';
+    $self->{'methods'}->{$name}++; # Moose stores meta object here.
     *{ $pkg . '::' . $name } = $code;
 }
 
@@ -74,10 +75,11 @@ sub get_method_list {
 
     no strict 'refs';
     # Get all the CODE symbol table entries
-    my @functions = grep !/^meta$/,
-      grep { /\A[^\W\d]\w*\z/o }
+    my @functions =
+      grep !/(?:has|with|around|before|after|blessed|extends|confess)/,
       grep { defined &{"${name}::$_"} }
       keys %{"${name}::"};
+    push @functions, keys %{$self->{'methods'}->{$name}};
     wantarray ? @functions : \@functions;
 }
 
@@ -143,11 +145,13 @@ sub clone_instance {
 
 sub make_immutable {
     my $self = shift;
+    my %args = @_;
     my $name = $self->name;
     $self->{is_immutable}++;
-    no strict 'refs';
-    *{"$name\::new"}     = Mouse::Meta::Method::Constructor->generate_constructor_method_inline( $self );
-    *{"$name\::DESTROY"} = Mouse::Meta::Method::Destructor->generate_destructor_method_inline( $self );
+    $self->add_method('new' => Mouse::Meta::Method::Constructor->generate_constructor_method_inline( $self ));
+    if ($args{inline_destructor}) {
+        $self->add_method('DESTROY' => Mouse::Meta::Method::Destructor->generate_destructor_method_inline( $self ));
+    }
 }
 sub make_mutable {
     Carp::croak "Mouse::Meta::Class->make_mutable does not supported by Mouse";

diff --git a/lib/Mouse/Meta/Role.pm b/lib/Mouse/Meta/Role.pm
index 2ce294c..5f8f567 100644 (file)
--- a/lib/Mouse/Meta/Role.pm
+++ b/lib/Mouse/Meta/Role.pm
@@ -61,8 +61,8 @@ sub get_method_list {
 
     no strict 'refs';
     # Get all the CODE symbol table entries
-    my @functions = grep !/^meta$/,
-      grep { /\A[^\W\d]\w*\z/o }
+    my @functions =
+      grep !/(?:has|with|around|before|after|blessed|extends|confess|excludes|meta|requires)/,
       grep { defined &{"${name}::$_"} }
       keys %{"${name}::"};
     wantarray ? @functions : \@functions;
@@ -86,7 +86,7 @@ sub apply {
     {
         no strict 'refs';
         for my $name ($self->get_method_list) {
-            next if $name eq 'has' || $name eq 'requires' || $name eq 'meta' || $name eq 'with' || $name eq 'around' || $name eq 'before' || $name eq 'after' || $name eq 'blessed' || $name eq 'extends' || $name eq 'confess' || $name eq 'excludes';
+            next if $name eq 'meta';
 
             if ($classname->can($name)) {
                 # XXX what's Moose's behavior?
@@ -163,7 +163,7 @@ sub combine_apply {
             my $selfname = $self->name;
             my %args = %{ $role_spec->[1] };
             for my $name ($self->get_method_list) {
-                next if $name eq 'has' || $name eq 'requires' || $name eq 'meta' || $name eq 'with' || $name eq 'around' || $name eq 'before' || $name eq 'after' || $name eq 'blessed' || $name eq 'extends' || $name eq 'confess' || $name eq 'excludes';
+                next if $name eq 'meta';
 
                 if ($classname->can($name)) {
                     # XXX what's Moose's behavior?

diff --git a/t/000-recipes/001_point.t b/t/000-recipes/001_point.t
index 23f15d5..23d5e8f 100644 (file)
--- a/t/000-recipes/001_point.t
+++ b/t/000-recipes/001_point.t
@@ -33,6 +33,7 @@ BEGIN {
            $self->y(0);    
        }
        
+    __PACKAGE__->meta->make_immutable();
 }{     
        package Point3D;
        use Mouse;
@@ -46,6 +47,7 @@ BEGIN {
            $self->{z} = 0;
        };
        
+    __PACKAGE__->meta->make_immutable();
 }
 
 my $point = Point->new(x => 1, y => 2);        
@@ -139,13 +141,13 @@ is_deeply(
 my @Point_methods = qw(meta new x y clear);
 my @Point_attrs   = ('x', 'y');
 
-SKIP: {
-    skip "Mouse has no method introspection", 2 + @Point_methods;
+is_deeply(
+    [ sort @Point_methods                 ],
+    [ sort Point->meta->get_method_list() ],
+    '... we match the method list for Point');
 
-    is_deeply(
-        [ sort @Point_methods                 ],
-        [ sort Point->meta->get_method_list() ],
-        '... we match the method list for Point');
+SKIP: {
+    skip "Mouse has no method introspection", 1 + @Point_methods;
         
     is_deeply(
         [ sort @Point_attrs                      ],

diff --git a/t/034-apply_all_roles.t b/t/034-apply_all_roles.t
index b36ea2d..c2979ef 100644 (file)
--- a/t/034-apply_all_roles.t
+++ b/t/034-apply_all_roles.t
@@ -30,5 +30,5 @@ Mouse::Util::apply_all_roles('Baz', 'FooRole');
 my $baz = Baz->new;
 is $baz->foo, 'ok1';
 is $baz->bar, 'ok2';
-is join(",", sort $baz->meta->get_method_list), 'bar,foo';
+is join(",", sort $baz->meta->get_method_list), 'bar,foo,meta';
 

diff --git a/t/800_shikabased/013-compatibility-get_method_list.t b/t/800_shikabased/013-compatibility-get_method_list.t
new file mode 100644 (file)
index 0000000..8e85b84
--- /dev/null
+++ b/t/800_shikabased/013-compatibility-get_method_list.t
@@ -0,0 +1,37 @@
+use strict;
+use warnings;
+use Test::More;
+plan skip_all => "This test requires Moose" unless eval "require Moose; 1;";
+plan tests => 6;
+
+test($_) for qw/Moose Mouse/;
+exit;
+
+sub test {
+    my $class = shift;
+    eval <<"...";
+{
+    package ${class}Class;
+    use ${class};
+    sub foo { }
+    no ${class};
+}
+{
+    package ${class}ClassImm;
+    use ${class};
+    sub foo { }
+    no ${class};
+    __PACKAGE__->meta->make_immutable();
+}
+{
+    package ${class}Role;
+    use ${class}::Role;
+    sub bar { }
+}
+...
+    die $@ if $@;
+    is join(',', sort "${class}Class"->meta->get_method_list()),    'foo,meta';
+    is join(',', sort "${class}ClassImm"->meta->get_method_list()), 'foo,meta,new';
+    is join(',', sort "${class}Role"->meta->get_method_list()),     'bar';
+}
+