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