t/070_native_traits/060_trait_number.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         abs         => 'abs',
  14         add         => 'add',
  15         inc         => [ add => 1 ],
  16         div         => 'div',
  17         cut_in_half => [ div => 2 ],
  18         mod         => 'mod',
  19         odd         => [ mod => 2 ],
  20         mul         => 'mul',
  21         set         => 'set',
  22         sub         => 'sub',
  23         dec         => [ sub => 1 ],
  24     );
  25
  26     my $name = 'Foo1';
  27
  28     sub build_class {
  29         my %attr = @_;
  30
  31         my $class = Moose::Meta::Class->create(
  32             $name++,
  33             superclasses => ['Moose::Object'],
  34         );
  35
  36         $class->add_attribute(
  37             integer => (
  38                 traits  => ['Number'],
  39                 is      => 'ro',
  40                 isa     => 'Int',
  41                 default => 5,
  42                 handles => \%handles,
  43                 clearer => '_clear_integer',
  44                 %attr,
  45             ),
  46         );
  47
  48         return ( $class->name, \%handles );
  49     }
  50 }
  51
  52 {
  53     run_tests(build_class);
  54     run_tests( build_class( lazy => 1 ) );
  55 }
  56
  57 sub run_tests {
  58     my ( $class, $handles ) = @_;
  59
  60     can_ok( $class, $_ ) for sort keys %{$handles};
  61
  62     with_immutable {
  63         my $obj = $class->new;
  64
  65         is( $obj->integer, 5, 'Default to five' );
  66
  67         $obj->add(10);
  68
  69         is( $obj->integer, 15, 'Add ten for fithteen' );
  70
  71         throws_ok { $obj->add( 10, 2 ) }
  72         qr/Cannot call add with more than 1 argument/,
  73             'add throws an error when 2 arguments are passed';
  74
  75         $obj->sub(3);
  76
  77         is( $obj->integer, 12, 'Subtract three for 12' );
  78
  79         throws_ok { $obj->sub( 10, 2 ) }
  80         qr/Cannot call sub with more than 1 argument/,
  81             'sub throws an error when 2 arguments are passed';
  82
  83         $obj->set(10);
  84
  85         is( $obj->integer, 10, 'Set to ten' );
  86
  87         throws_ok { $obj->set( 10, 2 ) }
  88         qr/Cannot call set with more than 1 argument/,
  89             'set throws an error when 2 arguments are passed';
  90
  91         $obj->div(2);
  92
  93         is( $obj->integer, 5, 'divide by 2' );
  94
  95         throws_ok { $obj->div( 10, 2 ) }
  96         qr/Cannot call div with more than 1 argument/,
  97             'div throws an error when 2 arguments are passed';
  98
  99         $obj->mul(2);
 100
 101         is( $obj->integer, 10, 'multiplied by 2' );
 102
 103         throws_ok { $obj->mul( 10, 2 ) }
 104         qr/Cannot call mul with more than 1 argument/,
 105             'mul throws an error when 2 arguments are passed';
 106
 107         $obj->mod(2);
 108
 109         is( $obj->integer, 0, 'Mod by 2' );
 110
 111         throws_ok { $obj->mod( 10, 2 ) }
 112         qr/Cannot call mod with more than 1 argument/,
 113             'mod throws an error when 2 arguments are passed';
 114
 115         $obj->set(7);
 116
 117         $obj->mod(5);
 118
 119         is( $obj->integer, 2, 'Mod by 5' );
 120
 121         $obj->set(-1);
 122
 123         $obj->abs;
 124
 125         throws_ok { $obj->abs(10) }
 126         qr/Cannot call abs with any arguments/,
 127             'abs throws an error when an argument is passed';
 128
 129         is( $obj->integer, 1, 'abs 1' );
 130
 131         $obj->set(12);
 132
 133         $obj->inc;
 134
 135         is( $obj->integer, 13, 'inc 12' );
 136
 137         $obj->dec;
 138
 139         is( $obj->integer, 12, 'dec 13' );
 140
 141         if ( $class->meta->get_attribute('integer')->is_lazy ) {
 142             my $obj = $class->new;
 143
 144             $obj->add(2);
 145
 146             is( $obj->integer, 7, 'add with lazy default' );
 147
 148             $obj->_clear_integer;
 149
 150             $obj->mod(2);
 151
 152             is( $obj->integer, 1, 'mod with lazy default' );
 153         }
 154     }
 155     $class;
 156 }
 157
 158 done_testing;