Moose-2.1405HEADMoose-2.1405master

9 files changed, 569 insertions, 0 deletions

diff --git a/t/moose_util/apply_roles.t b/t/moose_util/apply_roles.t
new file mode 100644
index 0000000..48edea7
--- /dev/null
+++ b/t/moose_util/apply_roles.t
@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Moose::Util qw( apply_all_roles );
+
+{
+    package Role::Foo;
+    use Moose::Role;
+}
+
+{
+    package Role::Bar;
+    use Moose::Role;
+}
+
+{
+    package Role::Baz;
+    use Moose::Role;
+}
+
+{
+    package Class::A;
+    use Moose;
+}
+
+{
+    package Class::B;
+    use Moose;
+}
+
+{
+    package Class::C;
+    use Moose;
+}
+
+{
+    package Class::D;
+    use Moose;
+}
+
+{
+    package Class::E;
+    use Moose;
+}
+
+my @roles = qw( Role::Foo Role::Bar Role::Baz );
+apply_all_roles( 'Class::A', @roles );
+ok( Class::A->meta->does_role($_), "Class::A does $_" ) for @roles;
+
+apply_all_roles( 'Class::B', map { $_->meta } @roles );
+ok( Class::A->meta->does_role($_),
+    "Class::B does $_ (applied with meta role object)" )
+    for @roles;
+
+@roles = qw( Role::Foo );
+apply_all_roles( 'Class::C', @roles );
+ok( Class::A->meta->does_role($_), "Class::C does $_" ) for @roles;
+
+apply_all_roles( 'Class::D', map { $_->meta } @roles );
+ok( Class::A->meta->does_role($_),
+    "Class::D does $_ (applied with meta role object)" )
+    for @roles;
+
+@roles = qw( Role::Foo Role::Bar ), Role::Baz->meta;
+apply_all_roles( 'Class::E', @roles );
+ok( Class::A->meta->does_role($_),
+    "Class::E does $_ (mix of names and meta role object)" )
+    for @roles;
+
+done_testing;
diff --git a/t/moose_util/create_alias.t b/t/moose_util/create_alias.t
new file mode 100644
index 0000000..1f97104
--- /dev/null
+++ b/t/moose_util/create_alias.t
@@ -0,0 +1,102 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Moose qw(does_ok);
+
+BEGIN {
+    package Foo::Meta::Role;
+    use Moose::Role;
+    Moose::Util::meta_class_alias
+        FooRole => 'Foo::Meta::Role';
+
+    package Foo::Meta::Class;
+    use Moose;
+    extends 'Moose::Meta::Class';
+    with 'Foo::Meta::Role';
+    Moose::Util::meta_class_alias
+        FooClass => 'Foo::Meta::Class';
+
+    package Foo::Meta::Role::Attribute;
+    use Moose::Role;
+    Moose::Util::meta_attribute_alias
+        FooAttrRole => 'Foo::Meta::Role::Attribute';
+
+    package Foo::Meta::Attribute;
+    use Moose;
+    extends 'Moose::Meta::Attribute';
+    with 'Foo::Meta::Role::Attribute';
+    Moose::Util::meta_attribute_alias
+        FooAttrClass => 'Foo::Meta::Attribute';
+
+    package Bar::Meta::Role;
+    use Moose::Role;
+    Moose::Util::meta_class_alias 'BarRole';
+
+    package Bar::Meta::Class;
+    use Moose;
+    extends 'Moose::Meta::Class';
+    with 'Bar::Meta::Role';
+    Moose::Util::meta_class_alias 'BarClass';
+
+    package Bar::Meta::Role::Attribute;
+    use Moose::Role;
+    Moose::Util::meta_attribute_alias 'BarAttrRole';
+
+    package Bar::Meta::Attribute;
+    use Moose;
+    extends 'Moose::Meta::Attribute';
+    with 'Bar::Meta::Role::Attribute';
+    Moose::Util::meta_attribute_alias 'BarAttrClass';
+}
+
+package FooWithMetaClass;
+use Moose -metaclass => 'FooClass';
+
+has bar => (
+    metaclass => 'FooAttrClass',
+    is        => 'ro',
+);
+
+
+package FooWithMetaTrait;
+use Moose -traits => 'FooRole';
+
+has bar => (
+    traits => [qw(FooAttrRole)],
+    is     => 'ro',
+);
+
+package BarWithMetaClass;
+use Moose -metaclass => 'BarClass';
+
+has bar => (
+    metaclass => 'BarAttrClass',
+    is        => 'ro',
+);
+
+
+package BarWithMetaTrait;
+use Moose -traits => 'BarRole';
+
+has bar => (
+    traits => [qw(BarAttrRole)],
+    is     => 'ro',
+);
+
+package main;
+my $fwmc_meta = FooWithMetaClass->meta;
+my $fwmt_meta = FooWithMetaTrait->meta;
+isa_ok($fwmc_meta, 'Foo::Meta::Class');
+isa_ok($fwmc_meta->get_attribute('bar'), 'Foo::Meta::Attribute');
+does_ok($fwmt_meta, 'Foo::Meta::Role');
+does_ok($fwmt_meta->get_attribute('bar'), 'Foo::Meta::Role::Attribute');
+
+my $bwmc_meta = BarWithMetaClass->meta;
+my $bwmt_meta = BarWithMetaTrait->meta;
+isa_ok($bwmc_meta, 'Bar::Meta::Class');
+isa_ok($bwmc_meta->get_attribute('bar'), 'Bar::Meta::Attribute');
+does_ok($bwmt_meta, 'Bar::Meta::Role');
+does_ok($bwmt_meta->get_attribute('bar'), 'Bar::Meta::Role::Attribute');
+
+done_testing;
diff --git a/t/moose_util/ensure_all_roles.t b/t/moose_util/ensure_all_roles.t
new file mode 100644
index 0000000..9888bfb
--- /dev/null
+++ b/t/moose_util/ensure_all_roles.t
@@ -0,0 +1,62 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use Moose::Util ':all';
+
+{
+    package Foo;
+    use Moose::Role;
+}
+
+{
+    package Bar;
+    use Moose::Role;
+}
+
+{
+    package Quux;
+    use Moose;
+}
+
+is_deeply(
+    Quux->meta->roles,
+    [],
+    "no roles yet",
+);
+
+Foo->meta->apply(Quux->meta);
+
+is_deeply(
+    Quux->meta->roles,
+    [ Foo->meta ],
+    "applied Foo",
+);
+
+Foo->meta->apply(Quux->meta);
+Bar->meta->apply(Quux->meta);
+is_deeply(
+    Quux->meta->roles,
+    [ Foo->meta, Foo->meta, Bar->meta ],
+    "duplicated Foo",
+);
+
+is(does_role('Quux', 'Foo'), 1, "Quux does Foo");
+is(does_role('Quux', 'Bar'), 1, "Quux does Bar");
+ensure_all_roles('Quux', qw(Foo Bar));
+is_deeply(
+    Quux->meta->roles,
+    [ Foo->meta, Foo->meta, Bar->meta ],
+    "unchanged, since all roles are already applied",
+);
+
+my $obj = Quux->new;
+ensure_all_roles($obj, qw(Foo Bar));
+is_deeply(
+    $obj->meta->roles,
+    [ Foo->meta, Foo->meta, Bar->meta ],
+    "unchanged, since all roles are already applied",
+);
+
+done_testing;
diff --git a/t/moose_util/method_mod_args.t b/t/moose_util/method_mod_args.t
new file mode 100644
index 0000000..c4536d8
--- /dev/null
+++ b/t/moose_util/method_mod_args.t
@@ -0,0 +1,31 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Moose::Util qw( add_method_modifier );
+
+my $COUNT = 0;
+{
+    package Foo;
+    use Moose;
+
+    sub foo { }
+    sub bar { }
+}
+
+is( exception {
+    add_method_modifier('Foo', 'before', [ ['foo', 'bar'], sub { $COUNT++ } ]);
+}, undef, 'method modifier with an arrayref' );
+
+isnt( exception {
+    add_method_modifier('Foo', 'before', [ {'foo' => 'bar'}, sub { $COUNT++ } ]);
+}, undef, 'method modifier with a hashref' );
+
+my $foo = Foo->new;
+$foo->foo;
+$foo->bar;
+is($COUNT, 2, "checking that the modifiers were installed.");
+
+
+done_testing;
diff --git a/t/moose_util/moose_util.t b/t/moose_util/moose_util.t
new file mode 100644
index 0000000..3203f74
--- /dev/null
+++ b/t/moose_util/moose_util.t
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    use_ok('Moose::Util');
+}
+
+{
+    package Moosey::Class;
+    use Moose;
+}
+{
+    package Moosey::Role;
+    use Moose::Role;
+}
+{
+    package Other;
+}
+{
+    package Moosey::Composed;
+    use Moose;
+    with 'Moosey::Role';
+}
+
+use Moose::Util 'is_role';
+
+{
+    my $class = Moosey::Class->new;
+    my $composed = Moosey::Composed->new;
+
+    ok(!is_role('Moosey::Class'), 'a moose class is not a role');
+    ok(is_role('Moosey::Role'), 'a moose role is a role');
+    ok(!is_role('Other'), 'something else is not a role');
+    ok(!is_role('DoesNotExist'), 'non-existent namespace is not a role');
+    ok(!is_role('Moosey::Composed'), 'a moose class that composes a role is not a role');
+
+    ok(!is_role($class), 'instantiated moose object is not a role');
+    ok(!is_role($composed), 'instantiated moose object that does a role is not a role');
+}
+
+done_testing;
diff --git a/t/moose_util/moose_util_does_role.t b/t/moose_util/moose_util_does_role.t
new file mode 100644
index 0000000..916e3e7
--- /dev/null
+++ b/t/moose_util/moose_util_does_role.t
@@ -0,0 +1,92 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use Moose::Util ':all';
+
+{
+  package Foo;
+
+  use Moose::Role;
+}
+
+{
+  package Bar;
+
+  use Moose;
+
+  with qw/Foo/;
+}
+
+{
+  package Baz;
+
+  use Moose;
+}
+
+{
+  package Quux;
+
+  use metaclass;
+}
+
+{
+  package Foo::Foo;
+
+  use Moose::Role;
+
+  with 'Foo';
+}
+
+{
+  package DoesMethod;
+  use Moose;
+
+  sub does {
+    my $self = shift;
+    my ($role) = @_;
+    return 1 if $role eq 'Something::Else';
+    return $self->SUPER::does(@_);
+  }
+}
+
+# Classes
+
+ok(does_role('Bar', 'Foo'), '... Bar does Foo');
+
+ok(!does_role('Baz', 'Foo'), '... Baz doesnt do Foo');
+
+# Objects
+
+my $bar = Bar->new;
+
+ok(does_role($bar, 'Foo'), '... $bar does Foo');
+
+my $baz = Baz->new;
+
+ok(!does_role($baz, 'Foo'), '... $baz doesnt do Foo');
+
+# Invalid values
+
+ok(!does_role(undef,'Foo'), '... undef doesnt do Foo');
+
+ok(!does_role(1,'Foo'), '... 1 doesnt do Foo');
+
+# non Moose metaclass
+
+ok(!does_role('Quux', 'Foo'), '... Quux doesnt do Foo (does not die tho)');
+
+# overriding the does method works properly
+
+ok(does_role('DoesMethod', 'Something::Else'), '... can override the does method');
+
+# Self
+
+ok(does_role('Foo', 'Foo'), '... Foo does do Foo');
+
+# sub-Roles
+
+ok(does_role('Foo::Foo', 'Foo'), '... Foo::Foo does do Foo');
+
+done_testing;
diff --git a/t/moose_util/moose_util_search_class_by_role.t b/t/moose_util/moose_util_search_class_by_role.t
new file mode 100644
index 0000000..3984757
--- /dev/null
+++ b/t/moose_util/moose_util_search_class_by_role.t
@@ -0,0 +1,41 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use Moose::Util ':all';
+
+{   package SCBR::Role;
+    use Moose::Role;
+}
+
+{   package SCBR::A;
+    use Moose;
+}
+is search_class_by_role('SCBR::A', 'SCBR::Role'), undef, '... not found role returns undef';
+is search_class_by_role('SCBR::A', SCBR::Role->meta), undef, '... not found role returns undef';
+
+{   package SCBR::B;
+    use Moose;
+    extends 'SCBR::A';
+    with 'SCBR::Role';
+}
+is search_class_by_role('SCBR::B', 'SCBR::Role'), 'SCBR::B', '... class itself returned if it does role';
+is search_class_by_role('SCBR::B', SCBR::Role->meta), 'SCBR::B', '... class itself returned if it does role';
+
+{   package SCBR::C;
+    use Moose;
+    extends 'SCBR::B';
+}
+is search_class_by_role('SCBR::C', 'SCBR::Role'), 'SCBR::B', '... nearest class doing role returned';
+is search_class_by_role('SCBR::C', SCBR::Role->meta), 'SCBR::B', '... nearest class doing role returned';
+
+{   package SCBR::D;
+    use Moose;
+    extends 'SCBR::C';
+    with 'SCBR::Role';
+}
+is search_class_by_role('SCBR::D', 'SCBR::Role'), 'SCBR::D', '... nearest class being direct class returned';
+is search_class_by_role('SCBR::D', SCBR::Role->meta), 'SCBR::D', '... nearest class being direct class returned';
+
+done_testing;
diff --git a/t/moose_util/resolve_alias.t b/t/moose_util/resolve_alias.t
new file mode 100644
index 0000000..5b09b86
--- /dev/null
+++ b/t/moose_util/resolve_alias.t
@@ -0,0 +1,77 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use Moose::Util qw( resolve_metaclass_alias resolve_metatrait_alias );
+
+use lib 't/lib';
+
+# Doing each test twice is intended to make sure that the caching
+# doesn't break name resolution. It doesn't actually test that
+# anything is cached.
+is( resolve_metaclass_alias( 'Attribute', 'Moose::Meta::Attribute::Custom::Foo' ),
+    'Moose::Meta::Attribute::Custom::Foo',
+    'resolve_metaclass_alias finds Moose::Meta::Attribute::Custom::Foo' );
+
+is( resolve_metaclass_alias( 'Attribute', 'Moose::Meta::Attribute::Custom::Foo' ),
+    'Moose::Meta::Attribute::Custom::Foo',
+    'resolve_metaclass_alias finds Moose::Meta::Attribute::Custom::Foo second time' );
+
+is( resolve_metaclass_alias( 'Attribute', 'Foo' ),
+    'Moose::Meta::Attribute::Custom::Foo',
+    'resolve_metaclass_alias finds Moose::Meta::Attribute::Custom::Foo via alias (Foo)' );
+
+is( resolve_metaclass_alias( 'Attribute', 'Foo' ),
+    'Moose::Meta::Attribute::Custom::Foo',
+    'resolve_metaclass_alias finds Moose::Meta::Attribute::Custom::Foo via alias (Foo) a second time' );
+
+is( resolve_metaclass_alias( 'Attribute', 'Moose::Meta::Attribute::Custom::Bar' ),
+    'My::Bar',
+    'resolve_metaclass_alias finds Moose::Meta::Attribute::Custom::Bar as My::Bar' );
+
+is( resolve_metaclass_alias( 'Attribute', 'Moose::Meta::Attribute::Custom::Bar' ),
+    'My::Bar',
+    'resolve_metaclass_alias finds Moose::Meta::Attribute::Custom::Bar as My::Bar a second time' );
+
+is( resolve_metaclass_alias( 'Attribute', 'Bar' ),
+    'My::Bar',
+    'resolve_metaclass_alias finds Moose::Meta::Attribute::Custom::Bar as My::Bar via alias (Bar)' );
+
+is( resolve_metaclass_alias( 'Attribute', 'Bar' ),
+    'My::Bar',
+    'resolve_metaclass_alias finds Moose::Meta::Attribute::Custom::Bar as My::Bar via alias (Bar) a second time' );
+
+is( resolve_metatrait_alias( 'Attribute', 'Moose::Meta::Attribute::Custom::Trait::Foo' ),
+    'Moose::Meta::Attribute::Custom::Trait::Foo',
+    'resolve_metatrait_alias finds Moose::Meta::Attribute::Custom::Trait::Foo' );
+
+is( resolve_metatrait_alias( 'Attribute', 'Moose::Meta::Attribute::Custom::Trait::Foo' ),
+    'Moose::Meta::Attribute::Custom::Trait::Foo',
+    'resolve_metatrait_alias finds Moose::Meta::Attribute::Custom::Trait::Foo second time' );
+
+is( resolve_metatrait_alias( 'Attribute', 'Foo' ),
+    'Moose::Meta::Attribute::Custom::Trait::Foo',
+    'resolve_metatrait_alias finds Moose::Meta::Attribute::Custom::Trait::Foo via alias (Foo)' );
+
+is( resolve_metatrait_alias( 'Attribute', 'Foo' ),
+    'Moose::Meta::Attribute::Custom::Trait::Foo',
+    'resolve_metatrait_alias finds Moose::Meta::Attribute::Custom::Trait::Foo via alias (Foo) a second time' );
+
+is( resolve_metatrait_alias( 'Attribute', 'Moose::Meta::Attribute::Custom::Trait::Bar' ),
+    'My::Trait::Bar',
+    'resolve_metatrait_alias finds Moose::Meta::Attribute::Custom::Trait::Bar as My::Trait::Bar' );
+
+is( resolve_metatrait_alias( 'Attribute', 'Moose::Meta::Attribute::Custom::Trait::Bar' ),
+    'My::Trait::Bar',
+    'resolve_metatrait_alias finds Moose::Meta::Attribute::Custom::Trait::Bar as My::Trait::Bar a second time' );
+
+is( resolve_metatrait_alias( 'Attribute', 'Bar' ),
+    'My::Trait::Bar',
+    'resolve_metatrait_alias finds Moose::Meta::Attribute::Custom::Trait::Bar as My::Trait::Bar via alias (Bar)' );
+
+is( resolve_metatrait_alias( 'Attribute', 'Bar' ),
+    'My::Trait::Bar',
+    'resolve_metatrait_alias finds Moose::Meta::Attribute::Custom::Trait::Bar as My::Trait::Bar via alias (Bar) a second time' );
+
+done_testing;
diff --git a/t/moose_util/with_traits.t b/t/moose_util/with_traits.t
new file mode 100644
index 0000000..6388eeb
--- /dev/null
+++ b/t/moose_util/with_traits.t
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Moose;
+
+use Moose ();
+use Moose::Util qw(with_traits);
+
+{
+    package Foo;
+    use Moose;
+}
+
+{
+    package Foo::Role;
+    use Moose::Role;
+}
+
+{
+    package Foo::Role2;
+    use Moose::Role;
+}
+
+{
+    my $traited_class = with_traits('Foo', 'Foo::Role');
+    ok($traited_class->meta->is_anon_class, "we get an anon class");
+    isa_ok($traited_class, 'Foo');
+    does_ok($traited_class, 'Foo::Role');
+}
+
+{
+    my $traited_class = with_traits('Foo', 'Foo::Role', 'Foo::Role2');
+    ok($traited_class->meta->is_anon_class, "we get an anon class");
+    isa_ok($traited_class, 'Foo');
+    does_ok($traited_class, 'Foo::Role');
+    does_ok($traited_class, 'Foo::Role2');
+}
+
+{
+    my $traited_class = with_traits('Foo');
+    is($traited_class, 'Foo', "don't apply anything if we don't get any traits");
+}
+
+{
+    my $traited_class = with_traits('Foo', 'Foo::Role');
+    my $traited_class2 = with_traits('Foo', 'Foo::Role');
+    is($traited_class, $traited_class2, "get the same class back when passing the same roles");
+}
+
+done_testing;