From: gfx <gfuji@cpan.org>
Date: Tue, 8 Dec 2009 09:31:43 +0000 (+0900)
Subject: Add Test::Mouse
X-Git-Tag: 0.44~13
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=73e9153a57c2adfd533a0ac5a3ad843ebfd4c7e7

Add Test::Mouse
---

diff --git a/lib/Test/Mouse.pm b/lib/Test/Mouse.pm
new file mode 100644
index 0000000..34697eb
--- /dev/null
+++ b/lib/Test/Mouse.pm
@@ -0,0 +1,119 @@
+package Test::Mouse;
+
+use Mouse::Exporter;
+use Mouse::Util qw(does_role find_meta);
+
+use Test::Builder;
+
+Mouse::Exporter->setup_import_methods(
+    as_is => [qw(
+        meta_ok
+        does_ok
+        has_attribute_ok
+    )],
+);
+
+## the test builder instance ...
+
+my $Test = Test::Builder->new;
+
+## exported functions
+
+sub meta_ok ($;$) {
+    my ($class_or_obj, $message) = @_;
+
+    $message ||= "The object has a meta";
+
+    if (find_meta($class_or_obj)) {
+        return $Test->ok(1, $message)
+    }
+    else {
+        return $Test->ok(0, $message);
+    }
+}
+
+sub does_ok ($$;$) {
+    my ($class_or_obj, $does, $message) = @_;
+
+    $message ||= "The object does $does";
+
+    if (does_role($class_or_obj, $does)) {
+        return $Test->ok(1, $message)
+    }
+    else {
+        return $Test->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 $Test->ok(1, $message)
+    }
+    else {
+        return $Test->ok(0, $message);
+    }
+}
+
+1;
+__END__
+
+=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");
+
+=head1 DESCRIPTION
+
+This module provides some useful test functions for Mouse based classes. It
+is an experimental first release, so comments and suggestions are very welcome.
+
+=head1 EXPORTED FUNCTIONS
+
+=over 4
+
+=item B<meta_ok ($class_or_object)>
+
+Tests if a class or object has a metaclass.
+
+=item B<does_ok ($class_or_object, $role, ?$message)>
+
+Tests if a class or object does a certain role, similar to what C<isa_ok>
+does for the C<isa> method.
+
+=item B<has_attribute_ok($class_or_object, $attr_name, ?$message)>
+
+Tests if a class or object has a certain attribute, similar to what C<can_ok>
+does for the methods.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Test::More>
+
+=back
+
+=head1 SEE ALSO
+
+L<Mouse>
+
+L<Test::Moose>
+
+=cut
+
diff --git a/t/001_mouse/007-attributes.t b/t/001_mouse/007-attributes.t
index 925d4c4..4dba52a 100644
--- a/t/001_mouse/007-attributes.t
+++ b/t/001_mouse/007-attributes.t
@@ -3,9 +3,10 @@ use strict;
 use warnings;
 use Test::More tests => 21;
 use Test::Exception;
+use Test::Mouse;
 
 use lib 't/lib';
-use Test::Mouse;
+use MooseCompat;
 
 do {
     package Class;
diff --git a/t/020_attributes/015_attribute_traits.t b/t/020_attributes/015_attribute_traits.t
index eea984e..675d22c 100644
--- a/t/020_attributes/015_attribute_traits.t
+++ b/t/020_attributes/015_attribute_traits.t
@@ -9,6 +9,8 @@ use Test::More tests => 12;
 use Test::Exception;
 use Test::Mouse;
 
+use MooseCompat;
+
 {
     package My::Attribute::Trait;
     use Mouse::Role;
diff --git a/t/030_roles/001_meta_role.t b/t/030_roles/001_meta_role.t
index f18af27..d6160b6 100755
--- a/t/030_roles/001_meta_role.t
+++ b/t/030_roles/001_meta_role.t
@@ -6,9 +6,10 @@ use warnings;
 use Test::More tests => 26;
 use Test::Exception;
 
-use lib 't/lib';
-use Test::Mouse; # Mouse::Meta::Module->version
+use Test::Mouse;
 use Mouse::Meta::Role;
+use lib 't/lib';
+use MooseCompat;
 
 {
     package FooRole;
diff --git a/t/030_roles/002_role.t b/t/030_roles/002_role.t
index 67dcf44..2504039 100755
--- a/t/030_roles/002_role.t
+++ b/t/030_roles/002_role.t
@@ -7,7 +7,9 @@ use Test::More tests => 40;
 use Test::Exception;
 
 use lib 't/lib';
-use Test::Mouse; # Mouse::Meta::Module->version
+use Test::Mouse;
+
+use MooseCompat;
 
 =pod
 
diff --git a/t/030_roles/008_role_conflict_edge_cases.t b/t/030_roles/008_role_conflict_edge_cases.t
index 9a44f30..98f9a51 100644
--- a/t/030_roles/008_role_conflict_edge_cases.t
+++ b/t/030_roles/008_role_conflict_edge_cases.t
@@ -8,6 +8,7 @@ use Test::Exception;
 
 use lib 't/lib';
 use Test::Mouse;
+use MooseCompat;
 
 =pod
 
diff --git a/t/040_type_constraints/003_util_std_type_constraints.t b/t/040_type_constraints/003_util_std_type_constraints.t
index 6340227..a9d6a6d 100644
--- a/t/040_type_constraints/003_util_std_type_constraints.t
+++ b/t/040_type_constraints/003_util_std_type_constraints.t
@@ -7,7 +7,7 @@ use warnings;
 use Test::More tests => 277;
 use Test::Exception;
 
-use Test::Mouse;
+use MooseCompat;
 
 use Scalar::Util ();
 
diff --git a/t/040_type_constraints/005_util_type_coercion.t b/t/040_type_constraints/005_util_type_coercion.t
index c5fce12..b191095 100644
--- a/t/040_type_constraints/005_util_type_coercion.t
+++ b/t/040_type_constraints/005_util_type_coercion.t
@@ -7,7 +7,7 @@ use Test::More tests => 8; # tests => 26;
 use Test::Exception;
 
 use lib 't/lib';
-use Test::Mouse;
+use MooseCompat;
 
 BEGIN {
 	use_ok('Mouse::Util::TypeConstraints');
diff --git a/t/040_type_constraints/015_enum.t b/t/040_type_constraints/015_enum.t
index 48bdca6..dab1d0a 100755
--- a/t/040_type_constraints/015_enum.t
+++ b/t/040_type_constraints/015_enum.t
@@ -9,7 +9,7 @@ use Scalar::Util ();
 
 use lib 't/lib';
 use Mouse::Util::TypeConstraints;
-use Test::Mouse; # for export_type_constraints_as_functions()
+use MooseCompat;
 
 enum Letter => 'a'..'z', 'A'..'Z';
 enum Language => 'Perl 5', 'Perl 6', 'PASM', 'PIR'; # any others? ;)
diff --git a/t/300_immutable/001_immutable_moose.t b/t/300_immutable/001_immutable_moose.t
index 2c89b94..2d72554 100644
--- a/t/300_immutable/001_immutable_moose.t
+++ b/t/300_immutable/001_immutable_moose.t
@@ -6,10 +6,11 @@ use warnings;
 use Test::More tests => 15;
 use Test::Exception;
 
-use lib 't/lib';
-use Test::Mouse; # Mouse::Meta::Module->version
+use Test::Mouse;
 use Mouse::Meta::Role;
 
+use lib 't/lib';
+use MooseCompat;
 
 {
     package FooRole;
diff --git a/t/lib/MooseCompat.pm b/t/lib/MooseCompat.pm
new file mode 100644
index 0000000..19ae7cb
--- /dev/null
+++ b/t/lib/MooseCompat.pm
@@ -0,0 +1,66 @@
+package MooseCompat;
+# Moose compatible methods/functions
+
+package Mouse::Meta::Module;
+
+sub version   { no strict 'refs'; ${shift->name.'::VERSION'}   }
+sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} }
+sub identifier {
+    my $self = shift;
+    return join '-' => (
+       $self->name,
+        ($self->version   || ()),
+        ($self->authority || ()),
+    );
+}
+
+package Mouse::Meta::Role;
+
+for my $modifier_type (qw/before after around/) {
+    my $modifier = "${modifier_type}_method_modifiers";
+    my $has_method_modifiers = sub{
+        my($self, $method_name) = @_;
+        my $m = $self->{$modifier}->{$method_name};
+        return $m && @{$m} != 0;
+    };
+
+    no strict 'refs';
+    *{ 'has_' . $modifier_type . '_method_modifiers' } = $has_method_modifiers;
+}
+
+
+sub has_override_method_modifier {
+    my ($self, $method_name) = @_;
+    return exists $self->{override_method_modifiers}->{$method_name};
+}
+
+sub get_method_modifier_list {
+    my($self, $modifier_type) = @_;
+
+    return keys %{ $self->{$modifier_type . '_method_modifiers'} };
+}
+
+package Mouse::Util::TypeConstraints;
+
+use Mouse::Util::TypeConstraints ();
+
+sub export_type_constraints_as_functions { # TEST ONLY
+    my $into = caller;
+
+    foreach my $type( list_all_type_constraints() ) {
+        my $tc = find_type_constraint($type)->_compiled_type_constraint;
+        my $as = $into . '::' . $type;
+
+        no strict 'refs';
+        *{$as} = sub{ &{$tc} || undef };
+    }
+    return;
+}
+
+package
+    Mouse::Meta::Attribute;
+
+sub applied_traits{            $_[0]->{traits} } # TEST ONLY
+sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY
+
+1;
diff --git a/t/lib/Test/Mouse.pm b/t/lib/Test/Mouse.pm
deleted file mode 100644
index 2d46cbd..0000000
--- a/t/lib/Test/Mouse.pm
+++ /dev/null
@@ -1,143 +0,0 @@
-package Test::Mouse;
-
-use strict;
-use warnings;
-use Carp qw(croak);
-use Mouse::Util qw(find_meta does_role);
-
-use base qw(Test::Builder::Module);
-
-our @EXPORT = qw(meta_ok does_ok has_attribute_ok);
-
-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) = @_;
-
-    if(!defined $does){
-        croak "You must pass a role name";
-    }
-    $message ||= "The object does $does";
-
-    if (does_role($class_or_obj, $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);
-    }
-}
-
-# Moose compatible methods/functions
-
-package
-    Mouse::Meta::Module;
-
-sub version   { no strict 'refs'; ${shift->name.'::VERSION'}   }
-sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} }
-sub identifier {
-    my $self = shift;
-    return join '-' => (
-       $self->name,
-        ($self->version   || ()),
-        ($self->authority || ()),
-    );
-}
-
-package
-    Mouse::Meta::Role;
-
-for my $modifier_type (qw/before after around/) {
-    my $modifier = "${modifier_type}_method_modifiers";
-    my $has_method_modifiers = sub{
-        my($self, $method_name) = @_;
-        my $m = $self->{$modifier}->{$method_name};
-        return $m && @{$m} != 0;
-    };
-
-    no strict 'refs';
-    *{ 'has_' . $modifier_type . '_method_modifiers' } = $has_method_modifiers;
-}
-
-
-sub has_override_method_modifier {
-    my ($self, $method_name) = @_;
-    return exists $self->{override_method_modifiers}->{$method_name};
-}
-
-sub get_method_modifier_list {
-    my($self, $modifier_type) = @_;
-
-    return keys %{ $self->{$modifier_type . '_method_modifiers'} };
-}
-
-package
-    Mouse::Util::TypeConstraints;
-
-use Mouse::Util::TypeConstraints ();
-
-sub export_type_constraints_as_functions { # TEST ONLY
-    my $into = caller;
-
-    foreach my $type( list_all_type_constraints() ) {
-        my $tc = find_type_constraint($type)->_compiled_type_constraint;
-        my $as = $into . '::' . $type;
-
-        no strict 'refs';
-        *{$as} = sub{ &{$tc} || undef };
-    }
-    return;
-}
-
-package
-    Mouse::Meta::Attribute;
-
-sub applied_traits{            $_[0]->{traits} } # TEST ONLY
-sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY
-
-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
-