From: gfx <gfuji@cpan.org>
Date: Tue, 22 Sep 2009 01:02:45 +0000 (+0900)
Subject: Fix Makefile.PL to remove old xt/compatibility/* tests, and organize Mouse::Util
X-Git-Tag: 0.32~19
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=08f7a8dbc5e48fcece4396a500d37bb2c6e45b74;p=gitmo%2FMouse.git

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
--- 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
--- 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
--- 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
--- 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
--- 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) = @_;
+
+    my $meta = Mouse::Module::class_of($class_or_obj);
+
+    return 0 unless defined $meta;
+    return 1 if $meta->does_role($role);
+    return 0;
+}
+
+
+
 BEGIN {
     my $impl;
     if ($] >= 5.009_005) {
@@ -75,31 +99,30 @@ BEGIN {
     }
 }
 
-# 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 {
+        my ( $type, $metaclass_name, %options ) = @_;
+
+        my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
 
-        return $cache{$cache_key}{$metaclass_name} =
-            $loaded_class->can('register_implementation')
-          ? $loaded_class->register_implementation
-          : $loaded_class;
+        return $cache{$cache_key}{$metaclass_name} ||= do{
+
+            my $possible_full_name = join '::',
+                'Mouse::Meta', $type, 'Custom', ($options{trait} ? 'Trait' : ()), $metaclass_name
+            ;
+
+            my $loaded_class = load_first_existing_class(
+                $possible_full_name,
+                $metaclass_name
+            );
+
+            $loaded_class->can('register_implementation')
+                ? $loaded_class->register_implementation
+                : $loaded_class;
+        };
     }
 }
 
diff --git a/lib/Test/Mouse.pm b/lib/Test/Mouse.pm
deleted file mode 100755
index 6348746..0000000
--- a/lib/Test/Mouse.pm
+++ /dev/null
@@ -1,75 +0,0 @@
-package Test::Mouse;
-
-use strict;
-use warnings;
-use Mouse ();
-
-use base qw(Test::Builder::Module);
-
-our @EXPORT = qw(meta_ok does_ok has_attribute_ok);
-
-sub find_meta{ Mouse::class_of($class_or_obj) }
-
-sub meta_ok ($;$) {
-    my ($class_or_obj, $message) = @_;
-
-    $message ||= "The object has a meta";
-
-    if (find_meta($class_or_obj)) {
-        return __PACKAGE__->builder->ok(1, $message)
-    }
-    else {
-        return __PACKAGE__->builder->ok(0, $message);
-    }
-}
-
-sub does_ok ($$;$) {
-    my ($class_or_obj, $does, $message) = @_;
-
-    $message ||= "The object does $does";
-
-    my $meta = find_meta($class_or_obj);
-    if ($meta && $meta->does_role($does)) {
-        return __PACKAGE__->builder->ok(1, $message)
-    }
-    else {
-        return __PACKAGE__->builder->ok(0, $message);
-    }
-}
-
-sub has_attribute_ok ($$;$) {
-    my ($class_or_obj, $attr_name, $message) = @_;
-
-    $message ||= "The object does has an attribute named $attr_name";
-
-    my $meta = find_meta($class_or_obj);
-
-    if ($meta->find_attribute_by_name($attr_name)) {
-        return __PACKAGE__->builder->ok(1, $message)
-    }
-    else {
-        return __PACKAGE__->builder->ok(0, $message);
-    }
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Test::Mouse - Test functions for Mouse specific features
-
-=head1 SYNOPSIS
-
-  use Test::More plan => 1;
-  use Test::Mouse;
-
-  meta_ok($class_or_obj, "... Foo has a ->meta");
-  does_ok($class_or_obj, $role, "... Foo does the Baz role");
-  has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");
-
-=cut
-