use strict;
use warnings;
-use Test::More tests => 8;
+use Test::More;
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;
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More;
{
package Foo;
'in_global_destruction state is passed to DEMOLISH properly (true)'
) for split //, `$^X t/010_basics/020-global-destruction-helper.pl`;
+done_testing;
+++ /dev/null
-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;
-}
use strict;
use warnings;
-use Test::More tests => 86;
+use Test::More;
use Test::Exception;
{
'... 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),
is( $foo->bar, $foo2, '... got the right value for bar now' );
}
+
+done_testing;
use strict;
use warnings;
-use Test::More tests => 14;
+use Test::More;
use Test::Exception;
-
{
package Foo::Role;
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;
use strict;
use warnings;
-use Test::More tests => 88;
+use Test::More;
use Test::Exception;
=pod
is($test26->ghost, 'My::Test26::ghost', '... we access the attribute from the class and ignore the role attribute and method');
=cut
+
+done_testing;
use strict;
use warnings;
-use Test::More tests => 74;
-use Test::Exception;
+use Test::More;
+use Test::Exception;
{
is( eval { $class->method }, "concrete b", "provided by concrete b" );
}
}
+
+done_testing;
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.
is(blessed($obj), blessed($obj2), '... they share the same anon-class/role thing again');
}
-
-
-
+done_testing;
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More;
use Test::Exception;
-
{
package Foo;
use Mouse::Role;
is($c->baz_foo, 'Baz::foo', '... got the right method');
is($c->baz_bar, 'Baz::bar', '... got the right method');
-
-
-
-
+done_testing;
use strict;
use warnings;
-use Test::More tests => 11;
+use Test::More;
use Test::Exception;
use Scalar::Util 'blessed';
-
-
{
package Dog;
use Mouse::Role;
} '... and setting the accessor is okay';
is($obj->fur, "dirty", "role attr initialized");
+
+done_testing;
use strict;
use warnings;
-use Test::More tests => 7;
+use Test::More;
use Test::Exception;
use Scalar::Util 'blessed';
-
-
{
package Dog;
use Mouse::Role;
$foo->dog($bar)
} '... and setting the accessor is okay';
+done_testing;
#!/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 => {
$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;
--- /dev/null
+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;
projects / gitmo/Mouse.git / commitdiff