0.03

[gitmo/Moose-Policy.git] / t / 002_dynamic.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 12;

BEGIN {
    use_ok('Moose::Policy');
}

BEGIN {
    package My::Plain::Attribute;
    use Moose;
    extends 'Moose::Meta::Attribute';
}
BEGIN {
    package My::Bar::Attribute;
    use Moose;
    extends 'Moose::Meta::Attribute';
}
BEGIN {
    package My::Plain::Class;
    use Moose;
    extends 'Moose::Meta::Class';
}
BEGIN {
    package My::Bar::Class;
    use Moose;
    extends 'Moose::Meta::Class';
}
BEGIN {
    package My::Moose::Policy;
    # because writing subs is hard
    my %pkg_map = (
        qw(metaclass Class),
        qw(attribute_metaclass  Attribute),
        # TODO these:
        # qw(method_metaclass Method),
        # qw(instance_metaclass Instance),
    );
    foreach my $subname (keys(%pkg_map)) {
        my $pkg = $pkg_map{$subname};
        my $sub = sub {
            my $self = shift;
            my ($caller) = @_;
            return('My::Bar::' . $pkg)
                if($caller =~ m/^Bar(?:::|$)/);
            return 'My::Plain::' . $pkg;
        };
        no strict 'refs';
        *{$subname} = $sub;
    }
}
{
    package Foo;
    use Moose::Policy 'My::Moose::Policy';
}
{
    package Bar;
    use Moose::Policy 'My::Moose::Policy';
}
{
    package Bars;
    use Moose::Policy 'My::Moose::Policy';
}
{
    package Bar::None;
    use Moose::Policy 'My::Moose::Policy';
}

isa_ok(Foo->meta, 'Moose::Meta::Class');
is(Foo->meta->attribute_metaclass, 'My::Plain::Attribute',
    '... got our custom attr metaclass');

isa_ok(Bar->meta, 'Moose::Meta::Class');
isa_ok(Bar->meta, 'My::Bar::Class');
is(Bar->meta->attribute_metaclass, 'My::Bar::Attribute',
    '... got our custom attr metaclass');

isa_ok(Bars->meta, 'Moose::Meta::Class');
isa_ok(Bars->meta, 'My::Plain::Class');
is(Bars->meta->attribute_metaclass, 'My::Plain::Attribute',
    '... got our custom attr metaclass');

isa_ok(Bar::None->meta, 'Moose::Meta::Class');
isa_ok(Bar::None->meta, 'My::Bar::Class');
is(Bar::None->meta->attribute_metaclass, 'My::Bar::Attribute',
    '... got our custom attr metaclass');