From: gfx <gfuji@cpan.org>
Date: Wed, 10 Feb 2010 08:12:50 +0000 (+0900)
Subject: Update tests
X-Git-Tag: 0.50_01~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6475f69defb20a02b6559bddf870a0821f28ac20;p=gitmo%2FMouse.git

Update tests
---

diff --git a/t/010_basics/014_create_anon.t b/t/010_basics/014_create_anon.t
index 6e681d0..abae25e 100755
--- a/t/010_basics/014_create_anon.t
+++ b/t/010_basics/014_create_anon.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 8;
+use Test::More;
 
 use Mouse::Meta::Class;
 
@@ -70,3 +70,18 @@ use Mouse::Meta::Class;
 
     ok $class_and_bar->name->bar_role_applied;
 }
+
+# This tests that a cached metaclass can be reinitialized and still retain its
+# metaclass object.
+{
+    my $name = Mouse::Meta::Class->create_anon_class(
+        superclasses => ['Class'],
+        cache        => 1,
+    )->name;
+
+    $name->meta->reinitialize( $name );
+
+    can_ok( $name, 'meta' );
+}
+
+done_testing;
diff --git a/t/010_basics/failing/020-global-destruction-helper.pl b/t/010_basics/020-global-destruction-helper.pl
old mode 100755
new mode 100644
similarity index 100%
rename from t/010_basics/failing/020-global-destruction-helper.pl
rename to t/010_basics/020-global-destruction-helper.pl
diff --git a/t/010_basics/failing/020-global-destruction.t b/t/010_basics/020-global-destruction.t
old mode 100755
new mode 100644
similarity index 96%
rename from t/010_basics/failing/020-global-destruction.t
rename to t/010_basics/020-global-destruction.t
index 484a722..7bcecf0
--- a/t/010_basics/failing/020-global-destruction.t
+++ b/t/010_basics/020-global-destruction.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 4;
+use Test::More;
 
 {
     package Foo;
@@ -48,3 +48,4 @@ ok(
     'in_global_destruction state is passed to DEMOLISH properly (true)'
 ) for split //, `$^X t/010_basics/020-global-destruction-helper.pl`;
 
+done_testing;
diff --git a/t/010_basics/failing/021-instance-new.t b/t/010_basics/failing/021-instance-new.t
deleted file mode 100755
index 1c7d84d..0000000
--- a/t/010_basics/failing/021-instance-new.t
+++ /dev/null
@@ -1,25 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use Test::Exception;
-BEGIN {
-    eval "use Test::Output;";
-    plan skip_all => "Test::Output is required for this test" if $@;
-    plan tests => 2;
-}
-
-{
-    package Foo;
-    use Mouse;
-}
-
-{
-    my $foo = Foo->new();
-    stderr_like { $foo->new() }
-    qr/\QCalling new() on an instance is deprecated/,
-        '$object->new() is deprecated';
-
-    Foo->meta->make_immutable, redo
-        if Foo->meta->is_mutable;
-}
diff --git a/t/030_roles/003_apply_role.t b/t/030_roles/003_apply_role.t
index b4d2b38..2910669 100755
--- a/t/030_roles/003_apply_role.t
+++ b/t/030_roles/003_apply_role.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 86;
+use Test::More;
 use Test::Exception;
 
 {
@@ -92,7 +92,6 @@ ok( !$foobar_class_meta->does_role('OtherRole'),
     '... the FooBarClass->meta !does_role OtherRole' );
 
 foreach my $method_name (qw(bar baz foo boo blau goo)) {
-    #use Data::Dumper; $Data::Dumper::Maxdepth=1; diag(Dumper $foo_class_meta->{methods});
     ok( $foo_class_meta->has_method($method_name),
         '... FooClass has the method ' . $method_name );
     ok( $foobar_class_meta->has_method($method_name),
@@ -184,3 +183,5 @@ foreach my $foo ( $foo, $foobar ) {
 
     is( $foo->bar, $foo2, '... got the right value for bar now' );
 }
+
+done_testing;
diff --git a/t/030_roles/004_role_composition_errors.t b/t/030_roles/004_role_composition_errors.t
index 837af9f..8a9b04c 100644
--- a/t/030_roles/004_role_composition_errors.t
+++ b/t/030_roles/004_role_composition_errors.t
@@ -3,11 +3,10 @@
 use strict;
 use warnings;
 
-use Test::More tests => 14;
+use Test::More;
 use Test::Exception;
 
 
-
 {
 
     package Foo::Role;
@@ -155,3 +154,5 @@ is_deeply(
         qr/'Quux::Role' requires the methods 'meth3' and 'meth4' to be implemented by 'Quux::Class4'/,
         'exception mentions all the require methods that are accessors at once, as well as missing methods, but not the one that exists';
 }
+
+done_testing;
diff --git a/t/030_roles/005_role_conflict_detection.t b/t/030_roles/005_role_conflict_detection.t
index 2faeffd..b96851d 100644
--- a/t/030_roles/005_role_conflict_detection.t
+++ b/t/030_roles/005_role_conflict_detection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 88;
+use Test::More;
 use Test::Exception;
 
 =pod
@@ -573,3 +573,5 @@ isa_ok($test26, 'My::Test26');
 is($test26->ghost, 'My::Test26::ghost', '... we access the attribute from the class and ignore the role attribute and method');
 
 =cut
+
+done_testing;
diff --git a/t/030_roles/009_more_role_edge_cases.t b/t/030_roles/009_more_role_edge_cases.t
index 1849496..cb504d8 100644
--- a/t/030_roles/009_more_role_edge_cases.t
+++ b/t/030_roles/009_more_role_edge_cases.t
@@ -2,9 +2,9 @@
 
 use strict;
 use warnings;
-use Test::More tests => 74;
-use Test::Exception;
 
+use Test::More;
+use Test::Exception;
 
 
 {
@@ -253,3 +253,5 @@ use Test::Exception;
         is( eval { $class->method }, "concrete b", "provided by concrete b" );
     }
 }
+
+done_testing;
diff --git a/t/030_roles/010_run_time_role_composition.t b/t/030_roles/010_run_time_role_composition.t
index 6731d06..c4ba5ce 100644
--- a/t/030_roles/010_run_time_role_composition.t
+++ b/t/030_roles/010_run_time_role_composition.t
@@ -3,12 +3,11 @@
 use strict;
 use warnings;
 
-use Test::More tests => 27;
+use Test::More;
 
 use Scalar::Util qw(blessed);
 
 
-
 =pod
 
 This test can be used as a basis for the runtime role composition.
@@ -101,6 +100,4 @@ isa_ok($obj2, 'My::Class');
     is(blessed($obj), blessed($obj2), '... they share the same anon-class/role thing again');
 }
 
-
-
-
+done_testing;
diff --git a/t/030_roles/014_more_alias_and_exclude.t b/t/030_roles/014_more_alias_and_exclude.t
index e1d271d..ff0fc4d 100644
--- a/t/030_roles/014_more_alias_and_exclude.t
+++ b/t/030_roles/014_more_alias_and_exclude.t
@@ -3,11 +3,10 @@
 use strict;
 use warnings;
 
-use Test::More tests => 9;
+use Test::More;
 use Test::Exception;
 
 
-
 {
     package Foo;
     use Mouse::Role;
@@ -66,7 +65,4 @@ is($c->foo_gorch, 'Foo::gorch', '... got the right method');
 is($c->baz_foo, 'Baz::foo', '... got the right method');
 is($c->baz_bar, 'Baz::bar', '... got the right method');
 
-
-
-
-
+done_testing;
diff --git a/t/030_roles/015_runtime_roles_and_attrs.t b/t/030_roles/015_runtime_roles_and_attrs.t
index d1c0e4d..0e5def7 100644
--- a/t/030_roles/015_runtime_roles_and_attrs.t
+++ b/t/030_roles/015_runtime_roles_and_attrs.t
@@ -3,13 +3,11 @@
 use strict;
 use warnings;
 
-use Test::More tests => 11;
+use Test::More;
 use Test::Exception;
 use Scalar::Util 'blessed';
 
 
-
-
 {
     package Dog;
     use Mouse::Role;
@@ -55,3 +53,5 @@ lives_ok {
 } '... and setting the accessor is okay';
 
 is($obj->fur, "dirty", "role attr initialized");
+
+done_testing;
diff --git a/t/030_roles/016_runtime_roles_and_nonmoose.t b/t/030_roles/016_runtime_roles_and_nonmoose.t
index 1f6ec9b..080fe8a 100644
--- a/t/030_roles/016_runtime_roles_and_nonmoose.t
+++ b/t/030_roles/016_runtime_roles_and_nonmoose.t
@@ -3,13 +3,11 @@
 use strict;
 use warnings;
 
-use Test::More tests => 7;
+use Test::More;
 use Test::Exception;
 use Scalar::Util 'blessed';
 
 
-
-
 {
     package Dog;
     use Mouse::Role;
@@ -55,3 +53,4 @@ lives_ok {
     $foo->dog($bar)
 } '... and setting the accessor is okay';
 
+done_testing;
diff --git a/t/030_roles/035_anonymous_roles.t b/t/030_roles/035_anonymous_roles.t
index a79d1cc..7d64dfc 100644
--- a/t/030_roles/035_anonymous_roles.t
+++ b/t/030_roles/035_anonymous_roles.t
@@ -1,8 +1,8 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 7;
-use Mouse::Role ();
+use Test::More;
+use Mouse ();
 
 my $role = Mouse::Meta::Role->create_anon_role(
     attributes => {
@@ -27,9 +27,10 @@ ok($visored->is_worn, "accessor was consumed");
 $visored->remove;
 ok(!$visored->is_worn, "method was consumed");
 
-like($role->name, qr/::__ANON__::/, "the role name (is " . $role->name . ")");
+like($role->name, qr/::__ANON__::/, "");
 ok($role->is_anon_role, "the role knows it's anonymous");
 
 ok(Mouse::Util::is_class_loaded(Mouse::Meta::Role->create_anon_role->name), "creating an anonymous role satisifes is_class_loaded");
-ok(Mouse::Util::find_meta(Mouse::Meta::Role->create_anon_role->name), "creating an anonymous role satisifes class_of");
+ok(Mouse::Util::class_of(Mouse::Meta::Role->create_anon_role->name), "creating an anonymous role satisifes class_of");
 
+done_testing;
diff --git a/t/050_metaclasses/051_metarole_on_anon.t b/t/050_metaclasses/051_metarole_on_anon.t
new file mode 100644
index 0000000..f0ec101
--- /dev/null
+++ b/t/050_metaclasses/051_metarole_on_anon.t
@@ -0,0 +1,52 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use Mouse ();
+use Mouse::Meta::Class;
+use Mouse::Util::MetaRole;
+
+{
+    package Foo;
+    use Mouse;
+}
+
+{
+    package Role::Bar;
+    use Mouse::Role;
+}
+
+my $anon_name;
+
+{
+    my $anon_class = Mouse::Meta::Class->create_anon_class(
+        superclasses => ['Foo'],
+        cache        => 1,
+    );
+
+    $anon_name = $anon_class->name;
+
+    ok( $anon_name->meta, 'anon class has a metaclass' );
+}
+
+ok(
+    $anon_name->meta,
+    'cached anon class still has a metaclass after \$anon_class goes out of scope'
+);
+
+Mouse::Util::MetaRole::apply_metaroles(
+    for             => $anon_name,
+    class_metaroles => {
+        class => ['Role::Bar'],
+    },
+);
+
+BAIL_OUT('Cannot continue if the anon class does not have a metaclass')
+    unless $anon_name->can('meta');
+
+my $meta = $anon_name->meta;
+ok( $meta, 'cached anon class still has a metaclass applying a metarole' );
+
+done_testing;