From: Hans Dieter Pearcey Date: Thu, 25 Jun 2009 22:06:12 +0000 (-0400) Subject: remove unused (metaclass) tests X-Git-Tag: 0.89_02~126 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c77545e0f8a72205e00c8d2777775478cc338280;p=gitmo%2FMoose.git remove unused (metaclass) tests --- diff --git a/t/070_attribute_helpers/001_basic_counter.t b/t/070_attribute_helpers/001_basic_counter.t deleted file mode 100644 index 5bb0622..0000000 --- a/t/070_attribute_helpers/001_basic_counter.t +++ /dev/null @@ -1,78 +0,0 @@ -#!/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'); - diff --git a/t/070_attribute_helpers/002_basic_array.t b/t/070_attribute_helpers/002_basic_array.t deleted file mode 100644 index 7c091fd..0000000 --- a/t/070_attribute_helpers/002_basic_array.t +++ /dev/null @@ -1,241 +0,0 @@ -#!/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'); diff --git a/t/070_attribute_helpers/003_basic_hash.t b/t/070_attribute_helpers/003_basic_hash.t deleted file mode 100644 index 0c0bcd3..0000000 --- a/t/070_attribute_helpers/003_basic_hash.t +++ /dev/null @@ -1,186 +0,0 @@ -#!/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' -); diff --git a/t/070_attribute_helpers/004_basic_number.t b/t/070_attribute_helpers/004_basic_number.t deleted file mode 100644 index 79b66fa..0000000 --- a/t/070_attribute_helpers/004_basic_number.t +++ /dev/null @@ -1,108 +0,0 @@ -#!/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'); - diff --git a/t/070_attribute_helpers/005_basic_list.t b/t/070_attribute_helpers/005_basic_list.t deleted file mode 100644 index cf78c11..0000000 --- a/t/070_attribute_helpers/005_basic_list.t +++ /dev/null @@ -1,151 +0,0 @@ -#!/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'; - diff --git a/t/070_attribute_helpers/006_basic_bag.t b/t/070_attribute_helpers/006_basic_bag.t deleted file mode 100644 index f75048c..0000000 --- a/t/070_attribute_helpers/006_basic_bag.t +++ /dev/null @@ -1,76 +0,0 @@ -#!/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'); - diff --git a/t/070_attribute_helpers/007_basic_string.t b/t/070_attribute_helpers/007_basic_string.t deleted file mode 100644 index b7c9d03..0000000 --- a/t/070_attribute_helpers/007_basic_string.t +++ /dev/null @@ -1,118 +0,0 @@ -#!/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'); - diff --git a/t/070_attribute_helpers/012_basic_bool.t b/t/070_attribute_helpers/012_basic_bool.t deleted file mode 100644 index b156b47..0000000 --- a/t/070_attribute_helpers/012_basic_bool.t +++ /dev/null @@ -1,42 +0,0 @@ -#!/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'; -