view release on metacpan or  search on metacpan

t/meta/array_storage/association.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More tests => 41;
    
{
    package Class;
    use Abstract::Meta::Class ':all'; storage_type 'Array';
    has '$.to_one'  => (associated_class => 'AssociatedClass');
    has '@.ordered' => (associated_class => 'AssociatedClass');
    has '%.to_many' => (associated_class => 'AssociatedClass', index_by => 'a', item_accessor => 'association');
}

{
    package AssociatedClass;
    use Abstract::Meta::Class ':all'; storage_type 'Array';
    has '$.a';
}

{
    eval {Class->new(to_one => bless({},'main') )};
    like($@, qr{to_one must be of the AssociatedClass type},  'should catch invalid assocated_class - to one type');
    my $obj = Class->new(to_one => AssociatedClass->new);
    isa_ok($obj, 'Class');
    ok($obj->has_to_one, 'should have value');
    $obj->reset_to_one;
    ok(! $obj->has_to_one, 'should have reset value');
}

{
    eval {Class->new(ordered => [bless({},'main')])};
    like($@, qr{ordered must be of the AssociatedClass type},  'should catch invalid assocated_class - ordered type' );
    my $obj = Class->new(ordered => [AssociatedClass->new]);
    isa_ok($obj, 'Class');
    ok($obj->has_ordered, 'should have value');
    $obj->reset_ordered;
    ok(! $obj->has_ordered, 'should have reset value');
}

{
    eval {Class->new(to_many => [bless({},'main')])};
    like($@, qr{to_many must be of the AssociatedClass type},  'should catch invalid assocated_class - to many type');
    my @associations = (AssociatedClass->new(a => '002'), AssociatedClass->new(a => '302'));
    my $obj = Class->new(to_many => \@associations);
    isa_ok($obj, 'Class');
    my @exp_association = values %{$obj->to_many};
    is_deeply([sort @associations], [sort @exp_association], 'should have associations');

    is($obj->association('002'), $associations[0], 'should have indexed association');
    is($obj->association('302'), $associations[1], 'should have indexed association');

    ok($obj->has_to_many, 'should have value');
    $obj->reset_to_many;
    ok(! $obj->has_to_many, 'should have reset value');

}


{
    package ClassA;
    use Abstract::Meta::Class ':all'; storage_type 'Array';
    has '$.to_oneA'  => (associated_class => 'AssociatedClassA', the_other_end => 'classAA' );
    has '$.to_one'  => (associated_class => 'AssociatedClassA', the_other_end => 'classA' );
    has '@.ordered' => (associated_class => 'AssociatedClassA');