Squashed commit of the following:

[gitmo/Class-MOP.git] / t / 021_attribute_errors_and_edge_cases.t

use strict;
use warnings;

use Test::More;
use Test::Exception;

use Class::MOP;
use Class::MOP::Attribute;

# most values are static

{
    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            default => qr/hello (.*)/
        ));
    } '... no refs for defaults';

    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            default => []
        ));
    } '... no refs for defaults';

    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            default => {}
        ));
    } '... no refs for defaults';


    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            default => \(my $var)
        ));
    } '... no refs for defaults';

    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            default => bless {} => 'Foo'
        ));
    } '... no refs for defaults';

}

{
    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            builder => qr/hello (.*)/
        ));
    } '... no refs for builders';

    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            builder => []
        ));
    } '... no refs for builders';

    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            builder => {}
        ));
    } '... no refs for builders';


    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            builder => \(my $var)
        ));
    } '... no refs for builders';

    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            builder => bless {} => 'Foo'
        ));
    } '... no refs for builders';

    dies_ok {
        Class::MOP::Attribute->new('$test' => (
            builder => 'Foo', default => 'Foo'
        ));
    } '... no default AND builder';

    my $undef_attr;
    lives_ok {
        $undef_attr = Class::MOP::Attribute->new('$test' => (
            default   => undef,
            predicate => 'has_test',
        ));
    } '... undef as a default is okay';
    ok($undef_attr->has_default, '... and it counts as an actual default');
    ok(!Class::MOP::Attribute->new('$test')->has_default,
       '... but attributes with no default have no default');

    Class::MOP::Class->create(
        'Foo',
        attributes => [$undef_attr],
    );
    {
        my $obj = Foo->meta->new_object;
        ok($obj->has_test, '... and the default is populated');
        is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
    }
    lives_ok { Foo->meta->make_immutable }
             '... and it can be inlined';
    {
        my $obj = Foo->new;
        ok($obj->has_test, '... and the default is populated');
        is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
    }

}


{ # bad construtor args
    dies_ok {
        Class::MOP::Attribute->new();
    } '... no name argument';

    # These are no longer errors
    lives_ok {
        Class::MOP::Attribute->new('');
    } '... bad name argument';

    lives_ok {
        Class::MOP::Attribute->new(0);
    } '... bad name argument';
}

{
    my $attr = Class::MOP::Attribute->new('$test');
    dies_ok {
        $attr->attach_to_class();
    } '... attach_to_class died as expected';

    dies_ok {
        $attr->attach_to_class('Fail');
    } '... attach_to_class died as expected';

    dies_ok {
        $attr->attach_to_class(bless {} => 'Fail');
    } '... attach_to_class died as expected';
}

{
    my $attr = Class::MOP::Attribute->new('$test' => (
        reader => [ 'whoops, this wont work' ]
    ));

    $attr->attach_to_class(Class::MOP::Class->initialize('Foo'));

    dies_ok {
        $attr->install_accessors;
    } '... bad reader format';
}

{
    my $attr = Class::MOP::Attribute->new('$test');

    dies_ok {
        $attr->_process_accessors('fail', 'my_failing_sub');
    } '... cannot find "fail" type generator';
}


{
    {
        package My::Attribute;
        our @ISA = ('Class::MOP::Attribute');
        sub generate_reader_method { eval { die } }
    }

    my $attr = My::Attribute->new('$test' => (
        reader => 'test'
    ));

    dies_ok {
        $attr->install_accessors;
    } '... failed to generate accessors correctly';
}

{
    my $attr = Class::MOP::Attribute->new('$test' => (
        predicate => 'has_test'
    ));

    my $Bar = Class::MOP::Class->create('Bar');
    isa_ok($Bar, 'Class::MOP::Class');

    $Bar->add_attribute($attr);

    can_ok('Bar', 'has_test');

    is($attr, $Bar->remove_attribute('$test'), '... removed the $test attribute');

    ok(!Bar->can('has_test'), '... Bar no longer has the "has_test" method');
}


{
    # NOTE:
    # the next three tests once tested that
    # the code would fail, but we lifted the
    # restriction so you can have an accessor
    # along with a reader/writer pair (I mean
    # why not really). So now they test that
    # it works, which is kinda silly, but it
    # tests the API change, so I keep it.

    lives_ok {
        Class::MOP::Attribute->new('$foo', (
            accessor => 'foo',
            reader   => 'get_foo',
        ));
    } '... can create accessors with reader/writers';

    lives_ok {
        Class::MOP::Attribute->new('$foo', (
            accessor => 'foo',
            writer   => 'set_foo',
        ));
    } '... can create accessors with reader/writers';

    lives_ok {
        Class::MOP::Attribute->new('$foo', (
            accessor => 'foo',
            reader   => 'get_foo',
            writer   => 'set_foo',
        ));
    } '... can create accessors with reader/writers';
}

done_testing;