t/070_native_traits/040_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 {
  12     my %handles = (
  13         inc_counter    => 'inc',
  14         inc_counter_2  => [ inc => 2 ],
  15         dec_counter    => 'dec',
  16         dec_counter_2  => [ dec => 2 ],
  17         reset_counter  => 'reset',
  18         set_counter    => 'set',
  19         set_counter_42 => [ set => 42 ],
  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
  58     with_immutable {
  59         my $obj = $class->new();
  60
  61         is( $obj->counter, 0, '... got the default value' );
  62
  63         $obj->inc_counter;
  64         is( $obj->counter, 1, '... got the incremented value' );
  65
  66         $obj->inc_counter;
  67         is( $obj->counter, 2, '... got the incremented value (again)' );
  68
  69         throws_ok { $obj->inc_counter( 1, 2 ) }
  70         qr/Cannot call inc with more than 1 argument/,
  71             'inc throws an error when two arguments are passed';
  72
  73         $obj->dec_counter;
  74         is( $obj->counter, 1, '... got the decremented value' );
  75
  76         throws_ok { $obj->dec_counter( 1, 2 ) }
  77         qr/Cannot call dec with more than 1 argument/,
  78             'dec throws an error when two arguments are passed';
  79
  80         $obj->reset_counter;
  81         is( $obj->counter, 0, '... got the original value' );
  82
  83         throws_ok { $obj->reset_counter(2) }
  84         qr/Cannot call reset with any arguments/,
  85             'reset throws an error when an argument is passed';
  86
  87         $obj->set_counter(5);
  88         is( $obj->counter, 5, '... set the value' );
  89
  90         throws_ok { $obj->set_counter( 1, 2 ) }
  91         qr/Cannot call set with more than 1 argument/,
  92             'set throws an error when two arguments are passed';
  93
  94         $obj->inc_counter(2);
  95         is( $obj->counter, 7, '... increment by arg' );
  96
  97         $obj->dec_counter(5);
  98         is( $obj->counter, 2, '... decrement by arg' );
  99
 100         $obj->inc_counter_2;
 101         is( $obj->counter, 4, '... curried increment' );
 102
 103         $obj->dec_counter_2;
 104         is( $obj->counter, 2, '... curried deccrement' );
 105
 106         $obj->set_counter_42;
 107         is( $obj->counter, 42, '... curried set' );
 108
 109         if ( $class->meta->get_attribute('counter')->is_lazy ) {
 110             my $obj = $class->new;
 111
 112             $obj->inc_counter;
 113             is( $obj->counter, 1, 'inc increments - with lazy default' );
 114
 115             $obj->_clear_counter;
 116
 117             $obj->dec_counter;
 118             is( $obj->counter, -1, 'dec decrements - with lazy default' );
 119         }
 120     }
 121     $class;
 122 }
 123
 124 done_testing;