Fix Makefile.PL to remove old xt/compatibility/* tests, and organize Mouse::Util

diff --git a/Makefile.PL b/Makefile.PL
index ecb51d7..a54311c 100755 (executable)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,3 +1,5 @@
+use strict;
+use warnings;
 use inc::Module::Install;
 use 5.008;
 
@@ -35,12 +37,14 @@ sub create_moose_compatibility_test {
     require File::Spec;
     require File::Basename;
 
-    print "Creating xt/compatibility/* ...\n";
+    print "Creating compatibility tests in xt/compatibility/* ...\n";
+
+    File::Path::rmtree(File::Spec->catfile('xt', 'compatibility'));
 
     # some test does not pass... currently skip it.
     my %SKIP_TEST = (
         '016-trigger.t'    => "trigger's argument is incompatble :(",
-        '020-load-class.t' => "&Moose::is_class_loaded doesn't exists",
+#        '020-load-class.t' => "&Moose::is_class_loaded doesn't exists",
         '019-handles.t'    => 'incompatible',
         '029-new.t'        => 'Class->new(undef) incompatible',
         '010-isa-or.t'     => 'Mouse has a [BUG]',
@@ -65,7 +69,11 @@ sub create_moose_compatibility_test {
 
                 my $basename = File::Basename::basename($_);
                 return if $basename =~ /^\./;
-                return if $SKIP_TEST{$basename};
+
+                if(exists $SKIP_TEST{$basename}){
+                    print "# skip $basename because: $SKIP_TEST{$basename}\n";
+                    return;
+                }
 
                 my $dirname = File::Basename::dirname($_);
 
@@ -82,6 +90,7 @@ sub create_moose_compatibility_test {
                         $s;
                     };
                     $src =~ s/Mouse::is_class_loaded/Class::MOP::is_class_loaded/g;
+                    $src =~ s/Mouse::load_class/Class::MOP::load_class/g;
                     $src =~ s/Mouse/Moose/g;
                     $src;
                 };
@@ -92,6 +101,8 @@ sub create_moose_compatibility_test {
         },
         't',
     );
+    print "Compatibility tests created.\n";
+
     clean_files "@compat_tests";
 }
 

diff --git a/lib/Mouse.pm b/lib/Mouse.pm
index b2296eb..8244532 100644 (file)
--- a/lib/Mouse.pm
+++ b/lib/Mouse.pm
@@ -11,7 +11,7 @@ use Scalar::Util 'blessed';
 use Mouse::Util qw(load_class is_class_loaded);
 
 use Mouse::Meta::Attribute;
-use Mouse::Meta::Module; # class_of()
+use Mouse::Meta::Module;
 use Mouse::Meta::Class;
 use Mouse::Object;
 use Mouse::Util::TypeConstraints;

diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index 3113b83..4215efa 100644 (file)
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -281,7 +281,7 @@ sub does_role {
         || $self->throw_error("You must supply a role name to look for");
 
     for my $class ($self->linearized_isa) {
-        my $meta = Mouse::class_of($class);
+        my $meta = Mouse::Meta::Module::class_of($class);
         next unless $meta && $meta->can('roles');
 
         for my $role (@{ $meta->roles }) {

diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm
index 6e4179b..091b8ef 100755 (executable)
--- a/lib/Mouse/Meta/Module.pm
+++ b/lib/Mouse/Meta/Module.pm
@@ -26,7 +26,7 @@ use Scalar::Util qw/blessed weaken/;
             ||= $class->_new(package => $package_name, @args);
     }
 
-    sub Mouse::class_of{
+    sub class_of{
         my($class_or_instance) = @_;
         return undef unless defined $class_or_instance;
         return $METACLASS_CACHE{ blessed($class_or_instance) || $class_or_instance };

diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index bcb865e..eb72c43 100644 (file)
--- a/lib/Mouse/Util.pm
+++ b/lib/Mouse/Util.pm
@@ -6,17 +6,41 @@ use Carp qw(confess);
 use B ();
 
 our @EXPORT_OK = qw(
+    find_meta
+    does_role
+    resolve_metaclass_alias
+
     load_class
     is_class_loaded
-    get_linear_isa
+
     apply_all_roles
-    get_code_info
     not_supported
+
+    get_linear_isa
+    get_code_info
 );
 our %EXPORT_TAGS = (
     all  => \@EXPORT_OK,
 );
 
+# Moose::Util compatible utilities
+
+sub find_meta{
+    return Mouse::Module::class_of( $_[0] );
+}
+
+sub does_role{
+    my ($class_or_obj, $role) = @_;\r
+\r
+    my $meta = Mouse::Module::class_of($class_or_obj);\r
+\r
+    return 0 unless defined $meta;\r
+    return 1 if $meta->does_role($role);\r
+    return 0;
+}
+
+
+
 BEGIN {
     my $impl;
     if ($] >= 5.009_005) {
@@ -75,31 +99,30 @@ BEGIN {
     }\r
 }
 
-# taken from Class/MOP.pm
+# taken from Mouse::Util (0.90)
 {
     my %cache;
 
-    sub resolve_metaclass_alias {
-        my ( $type, $metaclass_name, %options ) = @_;
-
-        my $cache_key = $type;
-        return $cache{$cache_key}{$metaclass_name}
-          if $cache{$cache_key}{$metaclass_name};
-
-        my $possible_full_name =
-            'Mouse::Meta::' 
-          . $type
-          . '::Custom::'
-          . $metaclass_name;
-
-        my $loaded_class =
-          load_first_existing_class( $possible_full_name,
-            $metaclass_name );
+    sub resolve_metaclass_alias {\r
+        my ( $type, $metaclass_name, %options ) = @_;\r
+\r
+        my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );\r
 
-        return $cache{$cache_key}{$metaclass_name} =
-            $loaded_class->can('register_implementation')
-          ? $loaded_class->register_implementation
-          : $loaded_class;
+        return $cache{$cache_key}{$metaclass_name} ||= do{\r
+\r
+            my $possible_full_name = join '::',
+                'Mouse::Meta', $type, 'Custom', ($options{trait} ? 'Trait' : ()), $metaclass_name
+            ;
+
+            my $loaded_class = load_first_existing_class(\r
+                $possible_full_name,\r
+                $metaclass_name\r
+            );\r
+\r
+            $loaded_class->can('register_implementation')\r
+                ? $loaded_class->register_implementation\r
+                : $loaded_class;
+        };\r
     }
 }
 

diff --git a/lib/Test/Mouse.pm b/lib/Test/Mouse.pm
deleted file mode 100755 (executable)
index 6348746..0000000
--- a/lib/Test/Mouse.pm
+++ /dev/null
@@ -1,75 +0,0 @@
-package Test::Mouse;\r
-\r
-use strict;\r
-use warnings;\r
-use Mouse ();\r
-\r
-use base qw(Test::Builder::Module);\r
-\r
-our @EXPORT = qw(meta_ok does_ok has_attribute_ok);\r
-\r
-sub find_meta{ Mouse::class_of($class_or_obj) }\r
-\r
-sub meta_ok ($;$) {\r
-    my ($class_or_obj, $message) = @_;\r
-\r
-    $message ||= "The object has a meta";\r
-\r
-    if (find_meta($class_or_obj)) {\r
-        return __PACKAGE__->builder->ok(1, $message)\r
-    }\r
-    else {\r
-        return __PACKAGE__->builder->ok(0, $message);\r
-    }\r
-}\r
-\r
-sub does_ok ($$;$) {\r
-    my ($class_or_obj, $does, $message) = @_;\r
-\r
-    $message ||= "The object does $does";\r
-\r
-    my $meta = find_meta($class_or_obj);\r
-    if ($meta && $meta->does_role($does)) {\r
-        return __PACKAGE__->builder->ok(1, $message)\r
-    }\r
-    else {\r
-        return __PACKAGE__->builder->ok(0, $message);\r
-    }\r
-}\r
-\r
-sub has_attribute_ok ($$;$) {\r
-    my ($class_or_obj, $attr_name, $message) = @_;\r
-\r
-    $message ||= "The object does has an attribute named $attr_name";\r
-\r
-    my $meta = find_meta($class_or_obj);\r
-\r
-    if ($meta->find_attribute_by_name($attr_name)) {\r
-        return __PACKAGE__->builder->ok(1, $message)\r
-    }\r
-    else {\r
-        return __PACKAGE__->builder->ok(0, $message);\r
-    }\r
-}\r
-\r
-1;\r
-\r
-__END__\r
-\r
-=pod\r
-\r
-=head1 NAME\r
-\r
-Test::Mouse - Test functions for Mouse specific features\r
-\r
-=head1 SYNOPSIS\r
-\r
-  use Test::More plan => 1;\r
-  use Test::Mouse;\r
-\r
-  meta_ok($class_or_obj, "... Foo has a ->meta");\r
-  does_ok($class_or_obj, $role, "... Foo does the Baz role");\r
-  has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");\r
-\r
-=cut\r
-\r