t/070_native_traits/203_trait_hash.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 46;
   7 use Test::Exception;
   8 use Test::Moose 'does_ok';
   9
  10 {
  11     package Stuff;
  12     use Moose;
  13
  14     has 'options' => (
  15         traits  => ['Hash'],
  16         is      => 'ro',
  17         isa     => 'HashRef[Str]',
  18         default => sub { {} },
  19         handles => {
  20             'set_option'       => 'set',
  21             'get_option'       => 'get',
  22             'has_no_options'   => 'is_empty',
  23             'num_options'      => 'count',
  24             'clear_options'    => 'clear',
  25             'delete_option'    => 'delete',
  26             'has_option'       => 'exists',
  27             'is_defined'       => 'defined',
  28             'option_accessor'  => 'accessor',
  29             'key_value'        => 'kv',
  30             'options_elements' => 'elements',
  31             'quantity'         => [ accessor => 'quantity' ],
  32         },
  33     );
  34 }
  35
  36 my $stuff = Stuff->new();
  37 isa_ok( $stuff, 'Stuff' );
  38
  39 can_ok( $stuff, $_ ) for qw[
  40     set_option
  41     get_option
  42     has_no_options
  43     num_options
  44     delete_option
  45     clear_options
  46     is_defined
  47     has_option
  48     quantity
  49     option_accessor
  50 ];
  51
  52 ok( $stuff->has_no_options, '... we have no options' );
  53 is( $stuff->num_options, 0, '... we have no options' );
  54
  55 is_deeply( $stuff->options, {}, '... no options yet' );
  56 ok( !$stuff->has_option('foo'), '... we have no foo option' );
  57
  58 lives_ok {
  59     $stuff->set_option( foo => 'bar' );
  60 }
  61 '... set the option okay';
  62
  63 ok( $stuff->is_defined('foo'), '... foo is defined' );
  64
  65 ok( !$stuff->has_no_options, '... we have options' );
  66 is( $stuff->num_options, 1, '... we have 1 option(s)' );
  67 ok( $stuff->has_option('foo'), '... we have a foo option' );
  68 is_deeply( $stuff->options, { foo => 'bar' }, '... got options now' );
  69
  70 lives_ok {
  71     $stuff->set_option( bar => 'baz' );
  72 }
  73 '... set the option okay';
  74
  75 is( $stuff->num_options, 2, '... we have 2 option(s)' );
  76 is_deeply( $stuff->options, { foo => 'bar', bar => 'baz' },
  77     '... got more options now' );
  78
  79 is( $stuff->get_option('foo'), 'bar', '... got the right option' );
  80
  81 is_deeply( [ $stuff->get_option(qw(foo bar)) ], [qw(bar baz)],
  82     "get multiple options at once" );
  83
  84 is( scalar($stuff->get_option(qw( foo bar) )), "baz",
  85        '... got last option in scalar context');
  86
  87 lives_ok {
  88     $stuff->set_option( oink => "blah", xxy => "flop" );
  89 }
  90 '... set the option okay';
  91
  92 is( $stuff->num_options, 4, "4 options" );
  93 is_deeply( [ $stuff->get_option(qw(foo bar oink xxy)) ],
  94     [qw(bar baz blah flop)], "get multiple options at once" );
  95
  96 lives_ok {
  97     $stuff->delete_option('bar');
  98 }
  99 '... deleted the option okay';
 100
 101 lives_ok {
 102     $stuff->delete_option('oink','xxy');
 103 }
 104 '... deleted multiple option okay';
 105
 106 is( $stuff->num_options, 1, '... we have 1 option(s)' );
 107 is_deeply( $stuff->options, { foo => 'bar' }, '... got more options now' );
 108
 109 $stuff->clear_options;
 110
 111 is_deeply( $stuff->options, {}, "... cleared options" );
 112
 113 lives_ok {
 114     $stuff->quantity(4);
 115 }
 116 '... options added okay with defaults';
 117
 118 is( $stuff->quantity, 4, 'reader part of curried accessor works' );
 119
 120 is_deeply( $stuff->options, { quantity => 4 }, '... returns what we expect' );
 121
 122 lives_ok {
 123     Stuff->new( options => { foo => 'BAR' } );
 124 }
 125 '... good constructor params';
 126
 127 ## check some errors
 128
 129 dies_ok {
 130     $stuff->set_option( bar => {} );
 131 }
 132 '... could not add a hash ref where an string is expected';
 133
 134 dies_ok {
 135     Stuff->new( options => { foo => [] } );
 136 }
 137 '... bad constructor params';
 138
 139 ## test the meta
 140
 141 my $options = $stuff->meta->get_attribute('options');
 142 does_ok( $options, 'Moose::Meta::Attribute::Native::Trait::Hash' );
 143
 144 is_deeply(
 145     $options->handles,
 146     {
 147         'set_option'       => 'set',
 148         'get_option'       => 'get',
 149         'has_no_options'   => 'is_empty',
 150         'num_options'      => 'count',
 151         'clear_options'    => 'clear',
 152         'delete_option'    => 'delete',
 153         'has_option'       => 'exists',
 154         'is_defined'       => 'defined',
 155         'option_accessor'  => 'accessor',
 156         'key_value'        => 'kv',
 157         'options_elements' => 'elements',
 158         'quantity'         => [ accessor => 'quantity' ],
 159     },
 160     '... got the right handles mapping'
 161 );
 162
 163 is( $options->type_constraint->type_parameter, 'Str',
 164     '... got the right container type' );
 165
 166 $stuff->set_option( oink => "blah", xxy => "flop" );
 167 my @key_value = sort{ $a->[0] cmp $b->[0] } $stuff->key_value;
 168 is_deeply(
 169     \@key_value,
 170     [ sort{ $a->[0] cmp $b->[0] } [ 'xxy', 'flop' ], [ 'quantity', 4 ], [ 'oink', 'blah' ] ],
 171     '... got the right key value pairs'
 172 ) or do{ require Data::Dumper; diag(Data::Dumper::Dumper(\@key_value)) };
 173
 174 my %options_elements = $stuff->options_elements;
 175 is_deeply(
 176     \%options_elements,
 177     {
 178         'oink'     => 'blah',
 179         'quantity' => 4,
 180         'xxy'      => 'flop'
 181     },
 182     '... got the right hash elements'
 183 );