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'   => '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 lives_ok {
  85     $stuff->set_option( oink => "blah", xxy => "flop" );
  86 }
  87 '... set the option okay';
  88
  89 is( $stuff->num_options, 4, "4 options" );
  90 is_deeply( [ $stuff->get_option(qw(foo bar oink xxy)) ],
  91     [qw(bar baz blah flop)], "get multiple options at once" );
  92
  93 lives_ok {
  94     $stuff->delete_option('bar');
  95 }
  96 '... deleted the option okay';
  97
  98 lives_ok {
  99     $stuff->delete_option('oink');
 100 }
 101 '... deleted the option okay';
 102
 103 lives_ok {
 104     $stuff->delete_option('xxy');
 105 }
 106 '... deleted the option okay';
 107
 108 is( $stuff->num_options, 1, '... we have 1 option(s)' );
 109 is_deeply( $stuff->options, { foo => 'bar' }, '... got more options now' );
 110
 111 $stuff->clear_options;
 112
 113 is_deeply( $stuff->options, {}, "... cleared options" );
 114
 115 lives_ok {
 116     $stuff->quantity(4);
 117 }
 118 '... options added okay with defaults';
 119
 120 is( $stuff->quantity, 4, 'reader part of curried accessor works' );
 121
 122 is_deeply( $stuff->options, { quantity => 4 }, '... returns what we expect' );
 123
 124 lives_ok {
 125     Stuff->new( options => { foo => 'BAR' } );
 126 }
 127 '... good constructor params';
 128
 129 ## check some errors
 130
 131 dies_ok {
 132     $stuff->set_option( bar => {} );
 133 }
 134 '... could not add a hash ref where an string is expected';
 135
 136 dies_ok {
 137     Stuff->new( options => { foo => [] } );
 138 }
 139 '... bad constructor params';
 140
 141 ## test the meta
 142
 143 my $options = $stuff->meta->get_attribute('options');
 144 does_ok( $options, 'Moose::Meta::Attribute::Native::Trait::Hash' );
 145
 146 is_deeply(
 147     $options->handles,
 148     {
 149         'set_option'       => 'set',
 150         'get_option'       => 'get',
 151         'has_no_options'   => 'empty',
 152         'num_options'      => 'count',
 153         'clear_options'    => 'clear',
 154         'delete_option'    => 'delete',
 155         'has_option'       => 'exists',
 156         'is_defined'       => 'defined',
 157         'option_accessor'  => 'accessor',
 158         'key_value'        => 'kv',
 159         'options_elements' => 'elements',
 160         'quantity'         => [ accessor => 'quantity' ],
 161     },
 162     '... got the right handles mapping'
 163 );
 164
 165 is( $options->type_constraint->type_parameter, 'Str',
 166     '... got the right container type' );
 167
 168 $stuff->set_option( oink => "blah", xxy => "flop" );
 169 my @key_value = $stuff->key_value;
 170 is_deeply(
 171     \@key_value,
 172     [ [ 'xxy', 'flop' ], [ 'quantity', 4 ], [ 'oink', 'blah' ] ],
 173     '... got the right key value pairs'
 174 );
 175
 176 my %options_elements = $stuff->options_elements;
 177 is_deeply(
 178     \%options_elements,
 179     {
 180         'oink'     => 'blah',
 181         'quantity' => 4,
 182         'xxy'      => 'flop'
 183     },
 184     '... got the right hash elements'
 185 );