+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 18;
-
-BEGIN {
- use_ok('Moose::AttributeHelpers');
-}
-
-{
- package MyHomePage;
- use Moose;
-
- has 'counter' => (
- metaclass => 'Counter',
- is => 'ro',
- isa => 'Int',
- default => sub { 0 },
- handles => {
- inc_counter => 'inc',
- dec_counter => 'dec',
- reset_counter => 'reset',
- set_counter => 'set'
- }
- );
-}
-
-my $page = MyHomePage->new();
-isa_ok($page, 'MyHomePage');
-
-can_ok($page, $_) for qw[
- dec_counter
- inc_counter
- reset_counter
- set_counter
-];
-
-is($page->counter, 0, '... got the default value');
-
-$page->inc_counter;
-is($page->counter, 1, '... got the incremented value');
-
-$page->inc_counter;
-is($page->counter, 2, '... got the incremented value (again)');
-
-$page->dec_counter;
-is($page->counter, 1, '... got the decremented 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');
-isa_ok($counter, 'Moose::AttributeHelpers::Counter');
-
-is($counter->helper_type, 'Num', '... got the expected helper type');
-
-is($counter->type_constraint->name, 'Int', '... got the expected type constraint');
-
-is_deeply($counter->handles, {
- inc_counter => 'inc',
- dec_counter => 'dec',
- reset_counter => 'reset',
- set_counter => 'set'
-}, '... got the right handles methods');
-
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 69;
-use Test::Exception;
-
-BEGIN {
- use_ok('Moose::AttributeHelpers');
-}
-
-{
- package Stuff;
- use Moose;
-
- has 'options' => (
- metaclass => 'Collection::Array',
- is => 'ro',
- isa => 'ArrayRef[Str]',
- default => sub { [] },
- handles => {
- 'add_options' => 'push',
- 'remove_last_option' => 'pop',
- 'remove_first_option' => 'shift',
- 'insert_options' => 'unshift',
- 'get_option_at' => 'get',
- 'set_option_at' => 'set',
- 'num_options' => 'count',
- 'has_options' => 'empty',
- 'clear_options' => 'clear',
- 'splice_options' => 'splice',
- 'sort_options_in_place' => 'sort_in_place',
- 'option_accessor' => 'accessor',
- 'add_optons_with_speed' =>
- [ 'push' => ['funrolls', 'funbuns'] ],
- 'prepend_prerequisites_along_with' =>
- [ 'unshift' => ['first', 'second'] ],
- 'descending_options' =>
- [ 'sort_in_place' => [ sub { $_[1] <=> $_[0] } ] ],
- },
- }
- );
-}
-
-my $stuff = Stuff->new(options => [ 10, 12 ]);
-isa_ok($stuff, 'Stuff');
-
-can_ok($stuff, $_) for qw[
- add_options
- remove_last_option
- remove_first_option
- insert_options
- get_option_at
- set_option_at
- num_options
- clear_options
- has_options
- sort_options_in_place
- option_accessor
-];
-
-is_deeply($stuff->options, [10, 12], '... got options');
-
-ok($stuff->has_options, '... we have options');
-is($stuff->num_options, 2, '... got 2 options');
-
-is($stuff->remove_last_option, 12, '... removed the last option');
-is($stuff->remove_first_option, 10, '... removed the last option');
-
-is_deeply($stuff->options, [], '... no options anymore');
-
-ok(!$stuff->has_options, '... no options');
-is($stuff->num_options, 0, '... got no options');
-
-lives_ok {
- $stuff->add_options(1, 2, 3);
-} '... set the option okay';
-
-is_deeply($stuff->options, [1, 2, 3], '... got options now');
-
-ok($stuff->has_options, '... no options');
-is($stuff->num_options, 3, '... got 3 options');
-
-is($stuff->get_option_at(0), 1, '... get option at index 0');
-is($stuff->get_option_at(1), 2, '... get option at index 1');
-is($stuff->get_option_at(2), 3, '... get option at index 2');
-
-lives_ok {
- $stuff->set_option_at(1, 100);
-} '... set the option okay';
-
-is($stuff->get_option_at(1), 100, '... get option at index 1');
-
-lives_ok {
- $stuff->add_options(10, 15);
-} '... set the option okay';
-
-is_deeply($stuff->options, [1, 100, 3, 10, 15], '... got more options now');
-
-is($stuff->num_options, 5, '... got 5 options');
-
-is($stuff->remove_last_option, 15, '... removed the last option');
-
-is($stuff->num_options, 4, '... got 4 options');
-is_deeply($stuff->options, [1, 100, 3, 10], '... got diff options now');
-
-lives_ok {
- $stuff->insert_options(10, 20);
-} '... set the option okay';
-
-is($stuff->num_options, 6, '... got 6 options');
-is_deeply($stuff->options, [10, 20, 1, 100, 3, 10], '... got diff options now');
-
-is($stuff->get_option_at(0), 10, '... get option at index 0');
-is($stuff->get_option_at(1), 20, '... get option at index 1');
-is($stuff->get_option_at(3), 100, '... get option at index 3');
-
-is($stuff->remove_first_option, 10, '... getting the first option');
-
-is($stuff->num_options, 5, '... got 5 options');
-is($stuff->get_option_at(0), 20, '... get option at index 0');
-
-$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->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);
-} '... rejects unshift of an invalid type';
-
-dies_ok {
- my $stuff = Stuff->new();
- $stuff->set_option_at( 0, undef );
-} '... rejects set of an invalid type';
-
-dies_ok {
- 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
-
-my $options = $stuff->meta->get_attribute('options');
-isa_ok($options, 'Moose::AttributeHelpers::Collection::Array');
-
-is_deeply($options->handles,
- 'add_options' => 'push',
- 'remove_last_option' => 'pop',
- 'remove_first_option' => 'shift',
- 'insert_options' => 'unshift',
- 'get_option_at' => 'get',
- 'set_option_at' => 'set',
- 'num_options' => 'count',
- 'has_options' => 'empty',
- 'clear_options' => 'clear',
- 'splice_options' => 'splice',
- 'sort_options_in_place' => 'sort_in_place',
- 'option_accessor' => 'accessor',
-}, '... got the right handles mapping');
-
-is($options->type_constraint->type_parameter, 'Str', '... got the right container type');
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 50;
-use Test::Exception;
-
-BEGIN {
- use_ok('Moose::AttributeHelpers');
-}
-
-{
- package Stuff;
- use Moose;
- use Moose::AttributeHelpers;
-
- has 'options' => (
- metaclass => 'Collection::Hash',
- is => 'ro',
- isa => 'HashRef[Str]',
- default => sub { {} },
- handles => {
- 'set_option' => 'set',
- 'get_option' => 'get',
- 'has_options' => 'empty',
- 'num_options' => 'count',
- 'clear_options' => 'clear',
- 'delete_option' => 'delete',
- 'has_option' => 'exists',
- 'is_defined' => 'defined',
- 'option_accessor' => 'accessor',
- 'key_value' => 'kv',
- 'options_elements' => 'elements',
- 'quantity' => [ accessor => ['quantity'] ],
- },
- );
-}
-
-my $stuff = Stuff->new();
-isa_ok($stuff, 'Stuff');
-
-can_ok($stuff, $_) for qw[
- set_option
- get_option
- has_options
- 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 {
- $stuff->set_option(bar => 'baz');
-} '... set the option okay';
-
-is($stuff->num_options, 2, '... we have 2 option(s)');
-is_deeply($stuff->options, { foo => 'bar', bar => 'baz' }, '... got more options now');
-
-is($stuff->get_option('foo'), 'bar', '... got the right option');
-
-is_deeply([ $stuff->get_option(qw(foo bar)) ], [qw(bar baz)], "get multiple options at once");
-
-lives_ok {
- $stuff->set_option(oink => "blah", xxy => "flop");
-} '... set the option okay';
-
-is($stuff->num_options, 4, "4 options");
-is_deeply([ $stuff->get_option(qw(foo bar oink xxy)) ], [qw(bar baz blah flop)], "get multiple options at once");
-
-lives_ok {
- $stuff->delete_option('bar');
-} '... deleted the option okay';
-
-lives_ok {
- $stuff->delete_option('oink');
-} '... deleted the option okay';
-
-lives_ok {
- $stuff->delete_option('xxy');
-} '... deleted the option okay';
-
-is($stuff->num_options, 1, '... we have 1 option(s)');
-is_deeply($stuff->options, { foo => 'bar' }, '... got more options now');
-
-$stuff->clear_options;
-
-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';
-
-## check some errors
-
-dies_ok {
- $stuff->set_option(bar => {});
-} '... could not add a hash ref where an string is expected';
-
-dies_ok {
- Stuff->new(options => { foo => [] });
-} '... bad constructor params';
-
-dies_ok {
- my $stuff = Stuff->new;
- $stuff->option_accessor();
-} '... accessor dies on 0 args';
-
-dies_ok {
- my $stuff = Stuff->new;
- $stuff->option_accessor(1 => 2, 3);
-} '... accessor dies on 3 args';
-
-dies_ok {
- my $stuff = Stuff->new;
- $stuff->option_accessor(1 => 2, 3 => 4);
-} '... accessor dies on 4 args';
-
-## test the meta
-
-my $options = $stuff->meta->get_attribute('options');
-isa_ok($options, 'Moose::AttributeHelpers::Collection::Hash');
-
-is_deeply($options->handles, {
- 'add_options' => 'push',
- 'remove_last_option' => 'pop',
- 'remove_first_option' => 'shift',
- 'insert_options' => 'unshift',
- 'get_option_at' => 'get',
- 'set_option_at' => 'set',
- 'num_options' => 'count',
- 'has_options' => 'empty',
- 'clear_options' => 'clear',
- 'splice_options' => 'splice',
- 'sort_options_in_place' => 'sort_in_place',
- 'option_accessor' => 'accessor',
-}, '... got the right handles 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'
-);
+++ /dev/null
-#!/usr/bin/perl
-
-
-use strict;
-use warnings;
-
-use Test::More tests => 26;
-
-BEGIN {
- use_ok('Moose::AttributeHelpers');
-}
-
-{
- package Real;
- use Moose;
-
- has 'integer' => (
- metaclass => 'Number',
- is => 'ro',
- isa => 'Int',
- default => sub { 5 },
- handles => {
- set => 'set',
- add => 'add',
- sub => 'sub',
- mul => 'mul',
- div => 'div',
- mod => 'mod',
- abs => 'abs',
- inc => [ add => [ 1 ] ],
- dec => [ sub => [ 1 ] ],
- odd => [ mod => [ 2 ] ],
- cut_in_half => [ div => [ 2 ] ],
-
- },
- );
-}
-
-my $real = Real->new;
-isa_ok($real, 'Real');
-
-can_ok($real, $_) for qw[
- set add sub mul div mod abs inc dec odd cut_in_half
-];
-
-is $real->integer, 5, 'Default to five';
-
-$real->add(10);
-
-is $real->integer, 15, 'Add ten for fithteen';
-
-$real->sub(3);
-
-is $real->integer, 12, 'Subtract three for 12';
-
-$real->set(10);
-
-is $real->integer, 10, 'Set to ten';
-
-$real->div(2);
-
-is $real->integer, 5, 'divide by 2';
-
-$real->mul(2);
-
-is $real->integer, 10, 'multiplied by 2';
-
-$real->mod(2);
-
-is $real->integer, 0, 'Mod by 2';
-
-$real->set(7);
-
-$real->mod(5);
-
-is $real->integer, 2, 'Mod by 5';
-
-$real->set(-1);
-
-$real->abs;
-
-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');
-isa_ok($attr, 'Moose::AttributeHelpers::Number');
-
-is_deeply($attr->handles, {
- set => 'set',
- add => 'add',
- sub => 'sub',
- mul => 'mul',
- div => 'div',
- mod => 'mod',
- abs => 'abs',
-}, '... got the right handles mapping');
-
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 35;
-use Test::Exception;
-
-BEGIN {
- use_ok('Moose::AttributeHelpers');
-}
-
-{
- package Stuff;
- use Moose;
-
- has '_options' => (
- metaclass => 'Collection::List',
- is => 'ro',
- isa => 'ArrayRef[Int]',
- init_arg => 'options',
- default => sub { [] },
- handles => {
- 'num_options' => 'count',
- 'has_options' => 'empty',
- 'map_options', => 'map',
- 'filter_options' => 'grep',
- 'find_option' => 'find',
- 'options' => 'elements',
- 'join_options' => 'join',
- 'get_option_at' => 'get',
- 'get_first_option' => 'first',
- 'get_last_option' => 'last',
- 'sorted_options' => 'sort',
- 'less_than_five' => [ grep => [ sub { $_ < 5 } ] ],
- 'up_by_one' => [ map => [ sub { $_ + 1 } ] ],
- 'dashify' => [ join => [ '-' ] ],
- 'descending' => [ sort => [ sub { $_[1] <=> $_[0] ] ],
- },
- );
-
- has animals => (
- is => 'rw',
- isa => 'ArrayRef[Str]',
- metaclass => 'Collection::List',
- handles => {
- double_length_of => [ grep => [ sub {
- my ($self, $body, $arg) = @_;
- $body->($self, sub { length($_) == length($arg) * 2 });
- } ] ],
- }
- )
-}
-
-my $stuff = Stuff->new(options => [ 1 .. 10 ]);
-isa_ok($stuff, 'Stuff');
-
-can_ok($stuff, $_) for qw[
- _options
- num_options
- has_options
- map_options
- filter_options
- 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 }) ],
-[ 2, 4, 6, 8, 10 ],
-'... got the right filtered values'
-);
-
-is_deeply(
-[ $stuff->map_options(sub { $_[0] * 2 }) ],
-[ 2, 4, 6, 8, 10, 12, 14, 16, 18, 20 ],
-'... got the right mapped values'
-);
-
-is($stuff->find_option(sub { $_[0] % 2 == 0 }), 2, '.. found the right option');
-
-is_deeply([ $stuff->options ], [1 .. 10], '... got the list of options');
-
-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');
-isa_ok($options, 'Moose::AttributeHelpers::Collection::List');
-
-is_deeply($options->handles, {
- 'num_options' => 'count',
- 'has_options' => 'empty',
- 'map_options', => 'map',
- 'filter_options' => 'grep',
- 'find_option' => 'find',
- 'options' => 'elements',
- 'join_options' => 'join',
- 'get_option_at' => 'get',
- 'get_first_option' => 'first',
- 'get_last_option' => 'last',
- 'sorted_options' => 'sort',
- 'less_than_five' => [ grep ],
- 'up_by_one' => [ map ],
- 'dashify' => [ join ],
- 'descending' => [ sort ],
-}, '... got the right handles 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';
-
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 20;
-use Test::Exception;
-
-BEGIN {
- use_ok('Moose::AttributeHelpers');
-}
-
-{
- package Stuff;
- use Moose;
- use Moose::AttributeHelpers;
-
- has 'word_histogram' => (
- metaclass => 'Collection::Bag',
- is => 'ro',
- provides => {
- 'add' => 'add_word',
- 'get' => 'get_count_for',
- 'empty' => 'has_any_words',
- 'count' => 'num_words',
- 'delete' => 'delete_word',
- }
- );
-}
-
-my $stuff = Stuff->new();
-isa_ok($stuff, 'Stuff');
-
-can_ok($stuff, $_) for qw[
- add_word
- get_count_for
- has_any_words
- num_words
- delete_word
-];
-
-ok(!$stuff->has_any_words, '... we have no words');
-is($stuff->num_words, 0, '... we have no words');
-
-lives_ok {
- $stuff->add_word('bar');
-} '... set the words okay';
-
-ok($stuff->has_any_words, '... we have words');
-is($stuff->num_words, 1, '... we have 1 word(s)');
-is($stuff->get_count_for('bar'), 1, '... got words now');
-
-lives_ok {
- $stuff->add_word('foo');
- $stuff->add_word('bar') for 0 .. 3;
- $stuff->add_word('baz') for 0 .. 10;
-} '... set the words okay';
-
-is($stuff->num_words, 3, '... we still have 1 word(s)');
-is($stuff->get_count_for('foo'), 1, '... got words now');
-is($stuff->get_count_for('bar'), 5, '... got words now');
-is($stuff->get_count_for('baz'), 11, '... got words now');
-
-## test the meta
-
-my $words = $stuff->meta->get_attribute('word_histogram');
-isa_ok($words, 'Moose::AttributeHelpers::Collection::Bag');
-
-is_deeply($words->provides, {
- 'add' => 'add_word',
- 'get' => 'get_count_for',
- 'empty' => 'has_any_words',
- 'count' => 'num_words',
- 'delete' => 'delete_word',
-}, '... got the right provides mapping');
-
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 27;
-
-BEGIN {
- use_ok('Moose::AttributeHelpers');
-}
-
-{
- package MyHomePage;
- use Moose;
-
- has 'string' => (
- metaclass => 'String',
- is => 'rw',
- isa => 'Str',
- default => sub { '' },
- provides => {
- inc => 'inc_string',
- append => 'append_string',
- prepend => 'prepend_string',
- match => 'match_string',
- replace => 'replace_string',
- 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], '') } },
- }
- );
-}
-
-my $page = MyHomePage->new();
-isa_ok($page, 'MyHomePage');
-
-is($page->string, '', '... got the default value');
-
-$page->string('a');
-
-$page->inc_string;
-is($page->string, 'b', '... got the incremented value');
-
-$page->inc_string;
-is($page->string, 'c', '... got the incremented value (again)');
-
-$page->append_string("foo$/");
-is($page->string, "cfoo$/", 'appended to string');
-
-$page->chomp_string;
-is($page->string, "cfoo", 'chomped string');
-
-$page->chomp_string;
-is($page->string, "cfoo", 'chomped is noop');
-
-$page->chop_string;
-is($page->string, "cfo", 'chopped string');
-
-$page->prepend_string("bar");
-is($page->string, 'barcfo', 'prepended to string');
-
-is_deeply( [ $page->match_string(qr/([ao])/) ], [ "a" ], "match" );
-
-$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");
-
-# check the meta ..
-
-my $string = $page->meta->get_attribute('string');
-isa_ok($string, 'Moose::AttributeHelpers::String');
-
-is($string->helper_type, 'Str', '... got the expected helper type');
-
-is($string->type_constraint->name, 'Str', '... got the expected type constraint');
-
-is_deeply($string->provides, {
- inc => 'inc_string',
- append => 'append_string',
- prepend => 'prepend_string',
- match => 'match_string',
- replace => 'replace_string',
- chop => 'chop_string',
- chomp => 'chomp_string',
- clear => 'clear_string',
- substr => 'sub_string',
-}, '... got the right provides methods');
-
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 8;
-use Moose::AttributeHelpers;
-
-{
- package Room;
- use Moose;
- has 'is_lit' => (
- metaclass => 'Bool',
- is => 'rw',
- isa => 'Bool',
- default => sub { 0 },
- provides => {
- set => 'illuminate',
- unset => 'darken',
- toggle => 'flip_switch',
- not => 'is_dark'
- }
- )
-}
-
-my $room = Room->new;
-$room->illuminate;
-ok $room->is_lit, 'set is_lit to 1 using ->illuminate';
-ok !$room->is_dark, 'check if is_dark does the right thing';
-
-$room->darken;
-ok !$room->is_lit, 'set is_lit to 0 using ->darken';
-ok $room->is_dark, 'check if is_dark does the right thing';
-
-$room->flip_switch;
-ok $room->is_lit, 'toggle is_lit back to 1 using ->flip_switch';
-ok !$room->is_dark, 'check if is_dark does the right thing';
-
-$room->flip_switch;
-ok !$room->is_lit, 'toggle is_lit back to 0 again using ->flip_switch';
-ok $room->is_dark, 'check if is_dark does the right thing';
-
projects / gitmo/Moose.git / commitdiff