use strict;
use warnings;
-use Test::More tests => 14;
+use Test::More tests => 18;
use Test::Moose 'does_ok';
BEGIN {
inc => 'inc_counter',
dec => 'dec_counter',
reset => 'reset_counter',
+ set => 'set_counter'
}
);
}
dec_counter
inc_counter
reset_counter
+ set_counter
];
is($page->counter, 0, '... got the default value');
$page->reset_counter;
is($page->counter, 0, '... got the original value');
+$page->set_counter(5);
+is($page->counter, 5, '... set the value');
+
+$page->inc_counter(2);
+is($page->counter, 7, '... increment by arg');
+
+$page->dec_counter(5);
+is($page->counter, 2, '... decrement by arg');
+
# check the meta ..
my $counter = $page->meta->get_attribute('counter');
is_deeply($counter->provides, {
inc => 'inc_counter',
dec => 'dec_counter',
- reset => 'reset_counter',
+ reset => 'reset_counter',
+ set => 'set_counter'
}, '... got the right provides methods');
use strict;
use warnings;
-use Test::More tests => 51;
+use Test::More tests => 69;
use Test::Exception;
use Test::Moose 'does_ok';
has 'options' => (
traits => [qw/MooseX::AttributeHelpers::Trait::Collection::Array/],
is => 'ro',
- isa => 'ArrayRef[Int]',
+ isa => 'ArrayRef[Str]',
default => sub { [] },
- provides => {
- 'push' => 'add_options',
- 'pop' => 'remove_last_option',
- 'shift' => 'remove_first_option',
- 'unshift' => 'insert_options',
- 'get' => 'get_option_at',
- 'set' => 'set_option_at',
- 'count' => 'num_options',
- 'empty' => 'has_options',
- 'clear' => 'clear_options',
+ provides => {
+ 'push' => 'add_options',
+ 'pop' => 'remove_last_option',
+ 'shift' => 'remove_first_option',
+ 'unshift' => 'insert_options',
+ 'get' => 'get_option_at',
+ 'set' => 'set_option_at',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'clear' => 'clear_options',
+ 'splice' => 'splice_options',
+ 'sort_in_place' => 'sort_options_in_place',
+ 'accessor' => 'option_accessor',
+ },
+ curries => {
+ 'push' => {
+ add_options_with_speed => ['funrolls', 'funbuns']
+ },
+ 'unshift' => {
+ prepend_prerequisites_along_with => ['first', 'second']
+ },
+ 'sort_in_place' => { descending_options => [ sub { $_[1] <=> $_[0] } ],
+ },
}
);
}
num_options
clear_options
has_options
+ sort_options_in_place
+ option_accessor
];
is_deeply($stuff->options, [10, 12], '... got options');
$stuff->clear_options;
is_deeply( $stuff->options, [], "... clear options" );
+$stuff->add_options(5, 1, 2, 3);
+$stuff->sort_options_in_place;
+is_deeply( $stuff->options, [1, 2, 3, 5], "... sort options in place (default sort order)" );
+
+$stuff->sort_options_in_place( sub { $_[1] <=> $_[0] } );
+is_deeply( $stuff->options, [5, 3, 2, 1], "... sort options in place (descending order)" );
+
+$stuff->clear_options();
+$stuff->add_options(5, 1, 2, 3);
+lives_ok {
+ $stuff->descending_options();
+} '... curried sort in place lives ok';
+
+is_deeply( $stuff->options, [5, 3, 2, 1], "... sort currying" );
+
+throws_ok { $stuff->sort_options_in_place('foo') } qr/Argument must be a code reference/,
+ 'error when sort_in_place receives a non-coderef argument';
+
+$stuff->clear_options;
+
+lives_ok {
+ $stuff->add_options('tree');
+} '... set the options okay';
+
+lives_ok {
+ $stuff->add_options_with_speed('compatible', 'safe');
+} '... add options with speed okay';
+
+is_deeply($stuff->options, [qw/tree funrolls funbuns compatible safe/],
+ 'check options after add_options_with_speed');
+
+lives_ok {
+ $stuff->prepend_prerequisites_along_with();
+} '... add prerequisite options okay';
+
+$stuff->clear_options;
+$stuff->add_options( 1, 2 );
+
+lives_ok {
+ $stuff->splice_options( 1, 0, 'foo' );
+} '... splice_options works';
+
+is_deeply(
+ $stuff->options, [ 1, 'foo', 2 ],
+ 'splice added expected option'
+);
+
+is($stuff->option_accessor(1 => 'foo++'), 'foo++');
+is($stuff->option_accessor(1), 'foo++');
+
## check some errors
+#dies_ok {
+# $stuff->insert_options(undef);
+#} '... could not add an undef where a string is expected';
+#
+#dies_ok {
+# $stuff->set_option(5, {});
+#} '... could not add a hash ref where a string is expected';
+
dies_ok {
- $stuff->add_options([]);
-} '... could not add an array ref where an int is expected';
+ Stuff->new(options => [ undef, 10, undef, 20 ]);
+} '... bad constructor params';
dies_ok {
+ my $stuff = Stuff->new();
+ $stuff->add_options(undef);
+} '... rejects push of an invalid type';
+
+dies_ok {
+ my $stuff = Stuff->new();
$stuff->insert_options(undef);
-} '... could not add an undef where an int is expected';
+} '... rejects unshift of an invalid type';
dies_ok {
- $stuff->set_option(5, {});
-} '... could not add a hash ref where an int is expected';
+ my $stuff = Stuff->new();
+ $stuff->set_option_at( 0, undef );
+} '... rejects set of an invalid type';
dies_ok {
- Stuff->new(options => [ 'Foo', 10, 'Bar', 20 ]);
-} '... bad constructor params';
+ my $stuff = Stuff->new();
+ $stuff->sort_in_place_options( undef );
+} '... sort rejects arg of invalid type';
+
+dies_ok {
+ my $stuff = Stuff->new();
+ $stuff->option_accessor();
+} '... accessor rejects 0 args';
+
+dies_ok {
+ my $stuff = Stuff->new();
+ $stuff->option_accessor(1, 2, 3);
+} '... accessor rejects 3 args';
## test the meta
'count' => 'num_options',
'empty' => 'has_options',
'clear' => 'clear_options',
-}, '... got the right provies mapping');
+ 'splice' => 'splice_options',
+ 'sort_in_place' => 'sort_options_in_place',
+ 'accessor' => 'option_accessor',
+}, '... got the right provides mapping');
-is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
+is($options->type_constraint->type_parameter, 'Str', '... got the right container type');
use strict;
use warnings;
-use Test::More tests => 35;
+use Test::More tests => 47;
use Test::Exception;
use Test::Moose 'does_ok';
isa => 'HashRef[Str]',
default => sub { {} },
provides => {
- 'set' => 'set_option',
- 'get' => 'get_option',
- 'empty' => 'has_options',
- 'count' => 'num_options',
- 'clear' => 'clear_options',
- 'delete' => 'delete_option',
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'clear' => 'clear_options',
+ 'delete' => 'delete_option',
+ 'exists' => 'has_option',
+ 'defined' => 'is_defined',
+ 'accessor' => 'option_accessor',
+ 'kv' => 'key_value',
+ 'elements' => 'options_elements',
+ },
+ curries => {
+ 'accessor' => {
+ quantity => ['quantity'],
+ },
}
);
}
num_options
delete_option
clear_options
+ is_defined
+ has_option
+ quantity
+ option_accessor
];
ok(!$stuff->has_options, '... we have no options');
is($stuff->num_options, 0, '... we have no options');
is_deeply($stuff->options, {}, '... no options yet');
+ok(!$stuff->has_option('foo'), '... we have no foo option');
lives_ok {
$stuff->set_option(foo => 'bar');
} '... set the option okay';
+ok($stuff->is_defined('foo'), '... foo is defined');
+
ok($stuff->has_options, '... we have options');
is($stuff->num_options, 1, '... we have 1 option(s)');
+ok($stuff->has_option('foo'), '... we have a foo option');
is_deeply($stuff->options, { foo => 'bar' }, '... got options now');
lives_ok {
is_deeply($stuff->options, { }, "... cleared options" );
lives_ok {
+ $stuff->quantity(4);
+} '... options added okay with defaults';
+
+is($stuff->quantity, 4, 'reader part of curried accessor works');
+
+is_deeply($stuff->options, {quantity => 4}, '... returns what we expect');
+
+lives_ok {
Stuff->new(options => { foo => 'BAR' });
} '... good constructor params';
does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::Hash');
is_deeply($options->provides, {
- 'set' => 'set_option',
- 'get' => 'get_option',
- 'empty' => 'has_options',
- 'count' => 'num_options',
- 'clear' => 'clear_options',
- 'delete' => 'delete_option',
-}, '... got the right provies mapping');
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'clear' => 'clear_options',
+ 'delete' => 'delete_option',
+ 'defined' => 'is_defined',
+ 'exists' => 'has_option',
+ 'accessor' => 'option_accessor',
+ 'kv' => 'key_value',
+ 'elements' => 'options_elements',
+}, '... got the right provides mapping');
is($options->type_constraint->type_parameter, 'Str', '... got the right container type');
+
+$stuff->set_option( oink => "blah", xxy => "flop" );
+my @key_value = $stuff->key_value;
+is_deeply(
+ \@key_value,
+ [ [ 'xxy', 'flop' ], [ 'quantity', 4 ], [ 'oink', 'blah' ] ],
+ '... got the right key value pairs'
+);
+
+my %options_elements = $stuff->options_elements;
+is_deeply(
+ \%options_elements,
+ {
+ 'oink' => 'blah',
+ 'quantity' => 4,
+ 'xxy' => 'flop'
+ },
+ '... got the right hash elements'
+);
use strict;
use warnings;
-use Test::More tests => 20;
+use Test::More tests => 26;
use Test::Moose;
BEGIN {
isa => 'Int',
default => sub { 5 },
provides => {
- set => 'set',
- add => 'add',
- sub => 'sub',
- mul => 'mul',
- div => 'div',
- mod => 'mod',
- abs => 'abs',
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+ },
+ curries => {
+ add => {inc => [ 1 ]},
+ sub => {dec => [ 1 ]},
+ mod => {odd => [ 2 ]},
+ div => {cut_in_half => [ 2 ]}
}
);
}
isa_ok($real, 'Real');
can_ok($real, $_) for qw[
- set add sub mul div mod abs
+ set add sub mul div mod abs inc dec odd cut_in_half
];
is $real->integer, 5, 'Default to five';
is $real->integer, 1, 'abs 1';
+$real->set(12);
+
+$real->inc;
+
+is $real->integer, 13, 'inc 12';
+
+$real->dec;
+
+is $real->integer, 12, 'dec 13';
+
## test the meta
my $attr = $real->meta->get_attribute('integer');
use strict;
use warnings;
-use Test::More tests => 21;
+use Test::More tests => 35;
use Test::Exception;
use Test::Moose 'does_ok';
'find' => 'find_option',
'elements' => 'options',
'join' => 'join_options',
+ 'get' => 'get_option_at',
+ 'first' => 'get_first_option',
+ 'last' => 'get_last_option',
+ 'sort' => 'sorted_options',
+ },
+ curries => {
+ 'grep' => {less_than_five => [ sub { $_ < 5 } ]},
+ 'map' => {up_by_one => [ sub { $_ + 1 } ]},
+ 'join' => {dashify => [ '-' ]},
+ 'sort' => {descending => [ sub { $_[1] <=> $_[0] } ]},
}
);
+
+ has animals => (
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ metaclass => 'Collection::List',
+ curries => {
+ grep => {
+ double_length_of => sub {
+ my ($self, $body, $arg) = @_;
+
+ $body->($self, sub { length($_) == length($arg) * 2 });
+ }
+ }
+ }
+ )
}
my $stuff = Stuff->new(options => [ 1 .. 10 ]);
find_option
options
join_options
+ get_option_at
+ sorted_options
];
is_deeply($stuff->_options, [1 .. 10], '... got options');
ok($stuff->has_options, '... we have options');
is($stuff->num_options, 10, '... got 2 options');
+cmp_ok($stuff->get_option_at(0), '==', 1, '... get option 0');
+cmp_ok($stuff->get_first_option, '==', 1, '... get first');
+cmp_ok($stuff->get_last_option, '==', 10, '... get last');
is_deeply(
[ $stuff->filter_options(sub { $_[0] % 2 == 0 }) ],
is($stuff->join_options(':'), '1:2:3:4:5:6:7:8:9:10', '... joined the list of options by :');
+is_deeply([ $stuff->sorted_options ], [sort (1..10)],
+ '... got sorted options (default sort order)');
+is_deeply([ $stuff->sorted_options( sub { $_[1] <=> $_[0] } ) ], [sort { $b <=> $a } (1..10)],
+ '... got sorted options (descending sort order) ');
+
+throws_ok { $stuff->sorted_options('foo') } qr/Argument must be a code reference/,
+ 'error when sort receives a non-coderef argument';
+
+# test the currying
+is_deeply([ $stuff->less_than_five() ], [1 .. 4]);
+
+is_deeply([ $stuff->up_by_one() ], [2 .. 11]);
+
+is($stuff->dashify, '1-2-3-4-5-6-7-8-9-10');
+
+$stuff->animals([ qw/cat duck horse cattle gorilla elephant flamingo kangaroo/ ]);
+
+# 4 * 2 = 8
+is_deeply(
+ [ sort $stuff->double_length_of('fish') ],
+ [ sort qw/elephant flamingo kangaroo/ ],
+ 'returns all elements with double length of string "fish"'
+);
+
+is_deeply([$stuff->descending], [reverse 1 .. 10]);
+
## test the meta
my $options = $stuff->meta->get_attribute('_options');
'empty' => 'has_options',
'elements' => 'options',
'join' => 'join_options',
-}, '... got the right provies mapping');
+ 'get' => 'get_option_at',
+ 'first' => 'get_first_option',
+ 'last' => 'get_last_option',
+ 'sort' => 'sorted_options',
+}, '... got the right provides mapping');
is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
+
+dies_ok {
+ $stuff->sort_in_place_options( undef );
+} '... sort rejects arg of invalid type';
+
use strict;
use warnings;
-use Test::More tests => 17;
+use Test::More tests => 27;
use Test::Moose 'does_ok';
BEGIN {
chop => 'chop_string',
chomp => 'chomp_string',
clear => 'clear_string',
+ substr => 'sub_string',
+ },
+ curries => {
+ append => {exclaim => [ '!' ]},
+ replace => {capitalize_last => [ qr/(.)$/, sub { uc $1 } ]},
+ match => {invalid_number => [ qr/\D/ ]},
+ substr => {shift_chars => sub { $_[1]->($_[0], 0, $_[2], '') } },
}
);
}
$page->replace_string(qr/([ao])/, sub { uc($1) });
is($page->string, 'bArcfo', "substitution");
+$page->exclaim;
+is($page->string, 'bArcfo!', 'exclaim!');
+
+is($page->sub_string(2), 'rcfo!', 'substr(offset)');
+is($page->sub_string(2, 2), 'rc', 'substr(offset, length)');
+is($page->sub_string(2, 2, ''), 'rc', 'substr(offset, length, replacement)');
+is($page->string, 'bAfo!', 'replacement got inserted');
+
+is($page->shift_chars(2), 'bA', 'curried substr');
+is($page->string, 'fo!', 'replacement got inserted');
+
+$page->string('Moosex');
+$page->capitalize_last;
+is($page->string, 'MooseX', 'capitalize last');
+
+$page->string('1234');
+ok(!$page->invalid_number, 'string "isn\'t an invalid number');
+
+$page->string('one two three four');
+ok($page->invalid_number, 'string an invalid number');
+
$page->clear_string;
is($page->string, '', "clear");
chop => 'chop_string',
chomp => 'chomp_string',
clear => 'clear_string',
+ substr => 'sub_string',
}, '... got the right provides methods');
projects / gitmo/MooseX-AttributeHelpers.git / commitdiff