path: root/t/exceptions/moose-meta-role-application-toclass.t

use strict;
use warnings;

use Test::More;
use Test::Fatal;

use Moose();

use Moose::Util 'find_meta';

{
    {
        package BarRole;
        use Moose::Role;
    }

    {
        package RoleExcludingBarRole;
        use Moose::Role;
        excludes 'BarRole';
    }

    my $exception = exception {
        {
            package FooClass;
            use Moose;

            with 'RoleExcludingBarRole';
            with 'BarRole';
        }
    };

    like(
        $exception,
        qr/\QConflict detected: FooClass excludes role 'BarRole'/,
        'class FooClass excludes Role BarRole');

    isa_ok(
        $exception,
        "Moose::Exception::ConflictDetectedInCheckRoleExclusionsInToClass",
        'class FooClass excludes Role BarRole');

    is(
        $exception->class_name,
        "FooClass",
        'class FooClass excludes Role BarRole');

    is(
        find_meta($exception->class_name),
        FooClass->meta,
        'class FooClass excludes Role BarRole');

    is(
        $exception->role_name,
        "BarRole",
        'class FooClass excludes Role BarRole');

    is(
        find_meta($exception->role_name),
        BarRole->meta,
        'class FooClass excludes Role BarRole');
}

{
    {
        package BarRole2;
        use Moose::Role;
        excludes 'ExcludedRole2';
    }

    {
        package ExcludedRole2;
        use Moose::Role;
    }

    my $exception = exception {
        {
            package FooClass2;
            use Moose;

            with 'ExcludedRole2';
            with 'BarRole2';
        }
    };

    like(
        $exception,
        qr/\QThe class FooClass2 does the excluded role 'ExcludedRole2'/,
        'Class FooClass2 does Role ExcludedRole2');

    isa_ok(
        $exception,
        "Moose::Exception::ClassDoesTheExcludedRole",
        'Class FooClass2 does Role ExcludedRole2');

    is(
        $exception->role_name,
        "BarRole2",
        'Class FooClass2 does Role ExcludedRole2');

    is(
        find_meta($exception->role_name),
        BarRole2->meta,
        'Class FooClass2 does Role ExcludedRole2');

    is(
        $exception->excluded_role_name,
        "ExcludedRole2",
        'Class FooClass2 does Role ExcludedRole2');

    is(
        find_meta($exception->excluded_role_name),
        ExcludedRole2->meta,
        'Class FooClass2 does Role ExcludedRole2');

    is(
        $exception->class_name,
        "FooClass2",
        'Class FooClass2 does Role ExcludedRole2');

    is(
        find_meta($exception->class_name),
        FooClass2->meta,
        'Class FooClass2 does Role ExcludedRole2');
}

{
    {
        package Foo5;
        use Moose::Role;

        sub foo5 { "foo" }
    }

    my $exception = exception {
        {
            package Bar5;
            use Moose;
            with 'Foo5' => {
                -alias    => { foo5 => 'foo_in_bar' }
            };

            sub foo_in_bar { "test in foo" }
        }
    };

    like(
        $exception,
        qr/\QCannot create a method alias if a local method of the same name exists/,
        "Class Bar5 already has a method named foo_in_bar");

    isa_ok(
        $exception,
        "Moose::Exception::CannotCreateMethodAliasLocalMethodIsPresentInClass",
        "Class Bar5 already has a method named foo_in_bar");

    is(
        $exception->role_name,
        "Foo5",
        "Class Bar5 already has a method named foo_in_bar");

    is(
        find_meta($exception->role_name),
        Foo5->meta,
        "Class Bar5 already has a method named foo_in_bar");

    is(
        $exception->class_name,
        "Bar5",
        "Class Bar5 already has a method named foo_in_bar");

    is(
        find_meta($exception->class_name),
        Bar5->meta,
        "Class Bar5 already has a method named foo_in_bar");

    is(
        $exception->aliased_method_name,
        "foo_in_bar",
        "Class Bar5 already has a method named foo_in_bar");

    is(
        $exception->method->name,
        "foo5",
        "Class Bar5 already has a method named foo_in_bar");
}

{
    {
        package Foo::Role;
        use Moose::Role;

        sub foo { 'Foo::Role::foo' }
    }

    {
        package Bar::Role;
        use Moose::Role;

        sub foo { 'Bar::Role::foo' }
    }

    {
        package Baz::Role;
        use Moose::Role;

        sub foo { 'Baz::Role::foo' }
    }

    my $exception = exception {
        {
            package My::Foo::Class::Broken;
            use Moose;

            with 'Foo::Role',
                 'Bar::Role',
                 'Baz::Role' => { -excludes => 'foo' };
        }
    };

    like(
        $exception,
        qr/\QDue to a method name conflict in roles 'Bar::Role' and 'Foo::Role', the method 'foo' must be implemented or excluded by 'My::Foo::Class::Broken'/,
        'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo');

    isa_ok(
        $exception,
        "Moose::Exception::MethodNameConflictInRoles",
        'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo');

    is(
        $exception->class_name,
        "My::Foo::Class::Broken",
        'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo');

    is(
        find_meta($exception->class_name),
        My::Foo::Class::Broken->meta,
        'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo');

    is(
        $exception->get_method_at(0)->name,
        "foo",
        'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo');

    is(
        $exception->get_method_at(0)->roles_as_english_list,
        "'Bar::Role' and 'Foo::Role'",
        'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo');
}

{
    {
        package Foo2::Role;
        use Moose::Role;

        sub foo { 'Foo2::Role::foo' }
        sub bar { 'Foo2::Role::bar' }
    }

    {
        package Bar2::Role;
        use Moose::Role;

        sub foo { 'Bar2::Role::foo' }
        sub bar { 'Bar2::Role::bar' }
    }

    {
        package Baz2::Role;
        use Moose::Role;

        sub foo { 'Baz2::Role::foo' }
        sub bar { 'Baz2::Role::bar' }
    }

    my $exception = exception {
        {
            package My::Foo::Class::Broken2;
            use Moose;

            with 'Foo2::Role',
                 'Bar2::Role',
                 'Baz2::Role';
        }
    };

    like(
        $exception,
        qr/\QDue to method name conflicts in roles 'Bar2::Role' and 'Foo2::Role', the methods 'bar' and 'foo' must be implemented or excluded by 'My::Foo::Class::Broken2'/,
        'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar');

    isa_ok(
        $exception,
        "Moose::Exception::MethodNameConflictInRoles",
        'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar');

    is(
        $exception->class_name,
        "My::Foo::Class::Broken2",
        'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar');

    is(
        find_meta($exception->class_name),
        My::Foo::Class::Broken2->meta,
        'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar');

    is(
        $exception->get_method_at(0)->roles_as_english_list,
        "'Bar2::Role' and 'Foo2::Role'",
        'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar');
}

{
    {
        package Foo3::Role;
        use Moose::Role;
        requires 'foo';
    }

    {
        package Bar3::Role;
        use Moose::Role;
    }

    {
        package Baz3::Role;
        use Moose::Role;
    }

    my $exception = exception {
        {
            package My::Foo::Class::Broken3;
            use Moose;
            with 'Foo3::Role',
                 'Bar3::Role',
                 'Baz3::Role';
        }
    };

    like(
        $exception,
        qr/\Q'Foo3::Role|Bar3::Role|Baz3::Role' requires the method 'foo' to be implemented by 'My::Foo::Class::Broken3'/,
        "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3");

    isa_ok(
        $exception,
        "Moose::Exception::RequiredMethodsNotImplementedByClass",
        "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3");

    is(
        $exception->class_name,
        "My::Foo::Class::Broken3",
        "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3");

    is(
        find_meta($exception->class_name),
        My::Foo::Class::Broken3->meta,
        "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3");

    is(
        $exception->role_name,
        'Foo3::Role|Bar3::Role|Baz3::Role',
        "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3");

    is(
        $exception->get_method_at(0)->name,
        "foo",
        "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3");
}

{
    BEGIN {
        package ExportsFoo;
        use Sub::Exporter -setup => {
            exports => ['foo'],
        };

        sub foo { 'FOO' }

        $INC{'ExportsFoo.pm'} = 1;
    }

    {
        package Foo4::Role;
        use Moose::Role;
        requires 'foo';
    }

    my $exception = exception {
        {
            package Class;
            use Moose;
            use ExportsFoo 'foo';
            with 'Foo4::Role';
        }
    };

    my $methodName = "\\&foo";

    like(
        $exception,
        qr/\Q'Foo4::Role' requires the method 'foo' to be implemented by 'Class'. If you imported functions intending to use them as methods, you need to explicitly mark them as such, via Class->meta->add_method(foo => $methodName)/,
        "foo is required by Foo4::Role and imported by Class");

    isa_ok(
        $exception,
        "Moose::Exception::RequiredMethodsImportedByClass",
        "foo is required by Foo4::Role and imported by Class");

    is(
        $exception->class_name,
        "Class",
        "foo is required by Foo4::Role and imported by Class");

    is(
        find_meta($exception->class_name),
        Class->meta,
        "foo is required by Foo4::Role and imported by Class");

    is(
        $exception->role_name,
        'Foo4::Role',
        "foo is required by Foo4::Role and imported by Class");

    is(
        $exception->get_method_at(0)->name,
        "foo",
        "foo is required by Foo4::Role and imported by Class");
}

done_testing;