t/070_native_traits/050_trait_hash.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Moose ();
   7 use Test::Exception;
   8 use Test::More;
   9 use Test::Moose;
  10
  11 {
  12     my %handles = (
  13         option_accessor  => 'accessor',
  14         quantity         => [ accessor => 'quantity' ],
  15         clear_options    => 'clear',
  16         num_options      => 'count',
  17         delete_option    => 'delete',
  18         is_defined       => 'defined',
  19         options_elements => 'elements',
  20         has_option       => 'exists',
  21         get_option       => 'get',
  22         has_no_options   => 'is_empty',
  23         key_value        => 'kv',
  24         set_option       => 'set',
  25     );
  26
  27     my $name = 'Foo1';
  28
  29     sub build_class {
  30         my %attr = @_;
  31
  32         my $class = Moose::Meta::Class->create(
  33             $name++,
  34             superclasses => ['Moose::Object'],
  35         );
  36
  37         $class->add_attribute(
  38             options => (
  39                 traits  => ['Hash'],
  40                 is      => 'ro',
  41                 isa     => 'HashRef[Str]',
  42                 default => sub { {} },
  43                 handles => \%handles,
  44                 clearer => '_clear_options',
  45                 %attr,
  46             ),
  47         );
  48
  49         return ( $class->name, \%handles );
  50     }
  51 }
  52
  53 {
  54     run_tests(build_class);
  55     run_tests( build_class( lazy => 1, default => sub { { x => 1 } } ) );
  56 }
  57
  58 sub run_tests {
  59     my ( $class, $handles ) = @_;
  60
  61     can_ok( $class, $_ ) for sort keys %{$handles};
  62
  63     with_immutable {
  64         my $obj = $class->new( options => {} );
  65
  66         ok( $obj->has_no_options, '... we have no options' );
  67         is( $obj->num_options, 0, '... we have no options' );
  68
  69         is_deeply( $obj->options, {}, '... no options yet' );
  70         ok( !$obj->has_option('foo'), '... we have no foo option' );
  71
  72         lives_ok {
  73             $obj->set_option( foo => 'bar' );
  74         }
  75         '... set the option okay';
  76
  77         ok( $obj->is_defined('foo'), '... foo is defined' );
  78
  79         ok( !$obj->has_no_options, '... we have options' );
  80         is( $obj->num_options, 1, '... we have 1 option(s)' );
  81         ok( $obj->has_option('foo'), '... we have a foo option' );
  82         is_deeply( $obj->options, { foo => 'bar' }, '... got options now' );
  83
  84         lives_ok {
  85             $obj->set_option( bar => 'baz' );
  86         }
  87         '... set the option okay';
  88
  89         is( $obj->num_options, 2, '... we have 2 option(s)' );
  90         is_deeply(
  91             $obj->options, { foo => 'bar', bar => 'baz' },
  92             '... got more options now'
  93         );
  94
  95         is( $obj->get_option('foo'), 'bar', '... got the right option' );
  96
  97         is_deeply(
  98             [ $obj->get_option(qw(foo bar)) ], [qw(bar baz)],
  99             "get multiple options at once"
 100         );
 101
 102         is(
 103             scalar( $obj->get_option(qw( foo bar)) ), "baz",
 104             '... got last option in scalar context'
 105         );
 106
 107         lives_ok {
 108             $obj->set_option( oink => "blah", xxy => "flop" );
 109         }
 110         '... set the option okay';
 111
 112         is( $obj->num_options, 4, "4 options" );
 113         is_deeply(
 114             [ $obj->get_option(qw(foo bar oink xxy)) ],
 115             [qw(bar baz blah flop)], "get multiple options at once"
 116         );
 117
 118         lives_ok {
 119             $obj->delete_option('bar');
 120         }
 121         '... deleted the option okay';
 122
 123         lives_ok {
 124             $obj->delete_option( 'oink', 'xxy' );
 125         }
 126         '... deleted multiple option okay';
 127
 128         is( $obj->num_options, 1, '... we have 1 option(s)' );
 129         is_deeply(
 130             $obj->options, { foo => 'bar' },
 131             '... got more options now'
 132         );
 133
 134         $obj->clear_options;
 135
 136         is_deeply( $obj->options, {}, "... cleared options" );
 137
 138         lives_ok {
 139             $obj->quantity(4);
 140         }
 141         '... options added okay with defaults';
 142
 143         is( $obj->quantity, 4, 'reader part of curried accessor works' );
 144
 145         is_deeply(
 146             $obj->options, { quantity => 4 },
 147             '... returns what we expect'
 148         );
 149
 150         lives_ok {
 151             $class->new( options => { foo => 'BAR' } );
 152         }
 153         '... good constructor params';
 154
 155         dies_ok {
 156             $obj->set_option( bar => {} );
 157         }
 158         '... could not add a hash ref where an string is expected';
 159
 160         dies_ok {
 161             $class->new( options => { foo => [] } );
 162         }
 163         '... bad constructor params';
 164
 165         $obj->set_option( oink => "blah", xxy => "flop" );
 166         my @key_value = sort { $a->[0] cmp $b->[0] } $obj->key_value;
 167         is_deeply(
 168             \@key_value,
 169             [
 170                 sort { $a->[0] cmp $b->[0] }[ 'xxy', 'flop' ],
 171                 [ 'quantity', 4 ],
 172                 [ 'oink',     'blah' ]
 173             ],
 174             '... got the right key value pairs'
 175             )
 176             or do {
 177             require Data::Dumper;
 178             diag( Data::Dumper::Dumper( \@key_value ) );
 179             };
 180
 181         my %options_elements = $obj->options_elements;
 182         is_deeply(
 183             \%options_elements, {
 184                 'oink'     => 'blah',
 185                 'quantity' => 4,
 186                 'xxy'      => 'flop'
 187             },
 188             '... got the right hash elements'
 189         );
 190
 191         if ( $class->meta->get_attribute('options')->is_lazy ) {
 192             my $obj = $class->new;
 193
 194             $obj->set_option( y => 2 );
 195
 196             is_deeply(
 197                 $obj->options, { x => 1, y => 2 },
 198                 'set_option with lazy default'
 199             );
 200
 201             $obj->_clear_options;
 202
 203             ok(
 204                 $obj->has_option('x'),
 205                 'key for x exists - lazy default'
 206             );
 207
 208             $obj->_clear_options;
 209
 210             ok(
 211                 $obj->is_defined('x'),
 212                 'key for x is defined - lazy default'
 213             );
 214
 215             $obj->_clear_options;
 216
 217             is_deeply(
 218                 [ $obj->key_value ],
 219                 [ [ x => 1 ] ],
 220                 'kv returns lazy default'
 221             );
 222         }
 223     }
 224     $class;
 225 }
 226
 227 done_testing;