view release on metacpan or  search on metacpan

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

use strict;
use warnings;

use Test::More tests => 47;

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

my $dummy = Dummy->new;
isa_ok($dummy, 'Dummy', 'should have a Dummy instance');
ok($dummy->can('x'), 'should have an accessor for x attribute');
ok($dummy->can('set_x'), 'should have a mutator for x attribute');
is($dummy->set_x(101), $dummy, 'should set a value');
is($dummy->x(101), '101', 'should get the value');


{
    package Dummy::Required;
    use Abstract::Meta::Class ':all'; storage_type 'Array';
    has '$.x' => (required => 1);
}

eval { Dummy::Required->new; };
like($@, qr/x is required/, 'should catch x is required attribute');
my $required = Dummy::Required->new(x => 1);
isa_ok($required, 'Dummy::Required', 'should have a Dummy::Required instance');

{
    package Dummy::Hash;
    use Abstract::Meta::Class ':all'; storage_type 'Array';
    has '%.xs' => (item_accessor => 'x', required => 1);
}

my $hash = Dummy::Hash->new(xs => {key1 => 1, key2 => 2});
isa_ok($hash, 'Dummy::Hash', 'should have a Dummy::Hash instance');
is($hash->x('key1'), 1, 'should have key1 value');
is($hash->x('key2'), 2, 'should have key2 value');


{
  package Dummy::Array;
  use Abstract::Meta::Class ':all'; storage_type 'Array';
  has '@.xs' => (item_accessor => 'x');
}

my $array = Dummy::Array->new(xs => [3, 2, 1]);
isa_ok($array, 'Dummy::Array', 'should have a Dummy::Array instance');
my $array_ref = $array->xs; # scalar context
is_deeply($array_ref, [3, 2, 1], 'should have xs attribute');
my @array = $array->xs; #list contect
is(@array, 3, 'should have 3 items');
is($array->x(0), 3, 'should have [0] value');
is($array->x(1), 2, 'should have [1] value');

is($array->count_xs, 3, 'should count');
is($array->push_xs(0,7), 5, 'should extent array by push');
is($array->x(4), 7, 'should have the last extended item');
is($array->pop_xs, 7, 'should pop item');
is($array->unshift_xs(5, 6), 6, 'should extent array by unshift');
is($array->x(0), 5, 'should have the first extended item');
is($array->shift_xs, 5, 'should shit item');