From: Shawn M Moore <sartak@gmail.com>
Date: Sun, 25 May 2008 01:12:20 +0000 (+0000)
Subject: Flesh out the rest of the trait tests
X-Git-Tag: 0.18_01~24
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0951a2297c156fde5db0d01d936d89d01648345c;p=gitmo%2FMooseX-AttributeHelpers.git

Flesh out the rest of the trait tests
---

diff --git a/t/202_trait_array.t b/t/202_trait_array.t
new file mode 100644
index 0000000..e7cffc6
--- /dev/null
+++ b/t/202_trait_array.t
@@ -0,0 +1,151 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 51;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+    use_ok('MooseX::AttributeHelpers');   
+}
+
+{
+    package Stuff;
+    use Moose;
+
+    has 'options' => (
+        traits    => [qw/Collection::Array/],
+        is        => 'ro',
+        isa       => 'ArrayRef[Int]',
+        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',        
+        }
+    );
+}
+
+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
+];
+
+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" );
+
+## check some errors
+
+dies_ok {
+    $stuff->add_options([]);
+} '... could not add an array ref where an int is expected';
+
+dies_ok {
+    $stuff->insert_options(undef);
+} '... could not add an undef where an int is expected';
+
+dies_ok {
+    $stuff->set_option(5, {});
+} '... could not add a hash ref where an int is expected';
+
+dies_ok {
+    Stuff->new(options => [ 'Foo', 10, 'Bar', 20 ]);
+} '... bad constructor params';
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('options');
+does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::Array');
+
+is_deeply($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',    
+}, '... got the right provies mapping');
+
+is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
diff --git a/t/203_trait_hash.t b/t/203_trait_hash.t
new file mode 100644
index 0000000..4f016e5
--- /dev/null
+++ b/t/203_trait_hash.t
@@ -0,0 +1,125 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 35;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+    use_ok('MooseX::AttributeHelpers');   
+}
+
+{
+    package Stuff;
+    use Moose;
+    use MooseX::AttributeHelpers;
+
+    has 'options' => (
+        traits    => [qw/Collection::Hash/],
+        is        => 'ro',
+        isa       => 'HashRef[Str]',
+        default   => sub { {} },
+        provides  => {
+            'set'    => 'set_option',
+            'get'    => 'get_option',            
+            'empty'  => 'has_options',
+            'count'  => 'num_options',
+            'clear'  => 'clear_options',
+            'delete' => 'delete_option',
+        }
+    );
+}
+
+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
+];
+
+ok(!$stuff->has_options, '... we have no options');
+is($stuff->num_options, 0, '... we have no options');
+
+is_deeply($stuff->options, {}, '... no options yet');
+
+lives_ok {
+    $stuff->set_option(foo => 'bar');
+} '... set the option okay';
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 1, '... we have 1 option(s)');
+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->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';
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('options');
+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');
+
+is($options->type_constraint->type_parameter, 'Str', '... got the right container type');
diff --git a/t/204_trait_number.t b/t/204_trait_number.t
new file mode 100644
index 0000000..2ae6105
--- /dev/null
+++ b/t/204_trait_number.t
@@ -0,0 +1,93 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+use Test::Moose;
+
+BEGIN {
+    use_ok('MooseX::AttributeHelpers');   
+}
+
+{
+    package Real;
+    use Moose;
+
+    has 'integer' => (
+        traits    => [qw/Number/],
+        is        => 'ro',
+        isa       => 'Int',
+        default   => sub { 5 },
+        provides  => {
+            set => 'set',
+            add => 'add',
+            sub => 'sub',
+            mul => 'mul',
+            div => 'div',
+            mod => 'mod',
+            abs => 'abs',
+        }
+    );
+}
+
+my $real = Real->new;
+isa_ok($real, 'Real');
+
+can_ok($real, $_) for qw[
+    set add sub mul div mod abs
+];
+
+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';
+
+## test the meta
+
+my $attr = $real->meta->get_attribute('integer');
+does_ok($attr, 'MooseX::AttributeHelpers::Trait::Number');
+
+is_deeply($attr->provides, {
+    set => 'set',
+    add => 'add',
+    sub => 'sub',
+    mul => 'mul',
+    div => 'div',
+    mod => 'mod',
+    abs => 'abs',
+}, '... got the right provides mapping');
+
diff --git a/t/205_trait_list.t b/t/205_trait_list.t
new file mode 100644
index 0000000..cd622d8
--- /dev/null
+++ b/t/205_trait_list.t
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 21;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+    use_ok('MooseX::AttributeHelpers');   
+}
+
+{
+    package Stuff;
+    use Moose;
+
+    has '_options' => (
+        traits    => [qw/Collection::List/],
+        is        => 'ro',
+        isa       => 'ArrayRef[Int]',
+        init_arg  => 'options',
+        default   => sub { [] },
+        provides  => {
+            'count'    => 'num_options',
+            'empty'    => 'has_options',        
+            'map'      => 'map_options',
+            'grep'     => 'filter_options',
+            'find'     => 'find_option',
+            'elements' => 'options',
+            'join'     => 'join_options',
+        }
+    );
+}
+
+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
+];
+
+is_deeply($stuff->_options, [1 .. 10], '... got options');
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 10, '... got 2 options');
+
+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 :');
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('_options');
+does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::List');
+
+is_deeply($options->provides, {
+    'map'      => 'map_options',
+    'grep'     => 'filter_options',
+    'find'     => 'find_option',
+    'count'    => 'num_options',
+    'empty'    => 'has_options',
+    'elements' => 'options',
+    'join'     => 'join_options',
+}, '... got the right provies mapping');
+
+is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
diff --git a/t/206_trait_bag.t b/t/206_trait_bag.t
new file mode 100644
index 0000000..105bb78
--- /dev/null
+++ b/t/206_trait_bag.t
@@ -0,0 +1,77 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+    use_ok('MooseX::AttributeHelpers');   
+}
+
+{
+    package Stuff;
+    use Moose;
+    use MooseX::AttributeHelpers;
+
+    has 'word_histogram' => (
+        traits    => [qw/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');
+does_ok($words, 'MooseX::AttributeHelpers::Trait::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/207_trait_string.t b/t/207_trait_string.t
new file mode 100644
index 0000000..0383870
--- /dev/null
+++ b/t/207_trait_string.t
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 17;
+use Test::Moose 'does_ok';
+
+BEGIN {
+    use_ok('MooseX::AttributeHelpers');   
+}
+
+{
+    package MyHomePage;
+    use Moose;
+
+    has 'string' => (
+        traits    => [qw/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',
+        }
+    );
+}
+
+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->clear_string;
+is($page->string, '', "clear");
+
+# check the meta ..
+
+my $string = $page->meta->get_attribute('string');
+does_ok($string, 'MooseX::AttributeHelpers::Trait::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',
+}, '... got the right provides methods');
+