t/070_native_traits/001_trait_counter.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 my %handles = (
  12     inc_counter    => 'inc',
  13     inc_counter_2  => [ inc => 2 ],
  14     dec_counter    => 'dec',
  15     dec_counter_2  => [ dec => 2 ],
  16     reset_counter  => 'reset',
  17     set_counter    => 'set',
  18     set_counter_42 => [ set => 42 ],
  19 );
  20
  21 {
  22     my $name = 'Foo1';
  23
  24     sub build_class {
  25         my %attr = @_;
  26
  27         my $class = Moose::Meta::Class->create(
  28             $name++,
  29             superclasses => ['Moose::Object'],
  30         );
  31
  32         $class->add_attribute(
  33             counter => (
  34                 traits  => ['Counter'],
  35                 is      => 'ro',
  36                 isa     => 'Int',
  37                 default => 0,
  38                 handles => \%handles,
  39                 clearer => '_clear_counter',
  40                 %attr,
  41             ),
  42         );
  43
  44         return ( $class->name, \%handles );
  45     }
  46 }
  47
  48 {
  49     run_tests(build_class);
  50     run_tests(build_class(lazy => 1));
  51 }
  52
  53 sub run_tests {
  54     my ( $class, $handles ) = @_;
  55
  56     can_ok( $class, $_ ) for sort keys %{$handles};
  57     with_immutable {
  58         my $obj = $class->new();
  59
  60         is( $obj->counter, 0, '... got the default value' );
  61
  62         $obj->inc_counter;
  63         is( $obj->counter, 1, '... got the incremented value' );
  64
  65         $obj->inc_counter;
  66         is( $obj->counter, 2, '... got the incremented value (again)' );
  67
  68         throws_ok { $obj->inc_counter( 1, 2 ) }
  69         qr/Cannot call inc with more than 1 argument/,
  70             'inc throws an error when two arguments are passed';
  71
  72         $obj->dec_counter;
  73         is( $obj->counter, 1, '... got the decremented value' );
  74
  75         throws_ok { $obj->dec_counter( 1, 2 ) }
  76         qr/Cannot call dec with more than 1 argument/,
  77             'dec throws an error when two arguments are passed';
  78
  79         $obj->reset_counter;
  80         is( $obj->counter, 0, '... got the original value' );
  81
  82         throws_ok { $obj->reset_counter(2) }
  83         qr/Cannot call reset with any arguments/,
  84             'reset throws an error when an argument is passed';
  85
  86         $obj->set_counter(5);
  87         is( $obj->counter, 5, '... set the value' );
  88
  89         throws_ok { $obj->set_counter( 1, 2 ) }
  90         qr/Cannot call set with more than 1 argument/,
  91             'set throws an error when two arguments are passed';
  92
  93         $obj->inc_counter(2);
  94         is( $obj->counter, 7, '... increment by arg' );
  95
  96         $obj->dec_counter(5);
  97         is( $obj->counter, 2, '... decrement by arg' );
  98
  99         $obj->inc_counter_2;
 100         is( $obj->counter, 4, '... curried increment' );
 101
 102         $obj->dec_counter_2;
 103         is( $obj->counter, 2, '... curried deccrement' );
 104
 105         $obj->set_counter_42;
 106         is( $obj->counter, 42, '... curried set' );
 107
 108         if ( $class->meta->get_attribute('counter')->is_lazy ) {
 109             my $obj = $class->new;
 110
 111             $obj->inc_counter;
 112             is( $obj->counter, 1, 'inc increments - with lazy default' );
 113
 114             $obj->_clear_counter;
 115
 116             $obj->dec_counter;
 117             is( $obj->counter, -1, 'dec decrements - with lazy default' );
 118         }
 119     }
 120     $class;
 121 }
 122
 123 done_testing;