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 Moose::Util::TypeConstraints;
   8 use Test::Exception;
   9 use Test::More;
  10 use Test::Moose;
  11
  12 {
  13     my %handles = (
  14         abs         => 'abs',
  15         add         => 'add',
  16         inc         => [ add => 1 ],
  17         div         => 'div',
  18         cut_in_half => [ div => 2 ],
  19         mod         => 'mod',
  20         odd         => [ mod => 2 ],
  21         mul         => 'mul',
  22         set         => 'set',
  23         sub         => 'sub',
  24         dec         => [ sub => 1 ],
  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             integer => (
  39                 traits  => ['Number'],
  40                 is      => 'ro',
  41                 isa     => 'Int',
  42                 default => 5,
  43                 handles => \%handles,
  44                 clearer => '_clear_integer',
  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 ) );
  56
  57     # Will force the inlining code to check the entire hashref when it is modified.
  58     subtype 'MyInt', as 'Int', where { 1 };
  59
  60     run_tests( build_class( isa => 'MyInt' ) );
  61
  62     coerce 'MyInt', from 'Int', via { $_ };
  63
  64     run_tests( build_class( isa => 'MyInt', coerce => 1 ) );
  65 }
  66
  67 sub run_tests {
  68     my ( $class, $handles ) = @_;
  69
  70     can_ok( $class, $_ ) for sort keys %{$handles};
  71
  72     with_immutable {
  73         my $obj = $class->new;
  74
  75         is( $obj->integer, 5, 'Default to five' );
  76
  77         $obj->add(10);
  78
  79         is( $obj->integer, 15, 'Add ten for fithteen' );
  80
  81         throws_ok { $obj->add( 10, 2 ) }
  82         qr/Cannot call add with more than 1 argument/,
  83             'add throws an error when 2 arguments are passed';
  84
  85         $obj->sub(3);
  86
  87         is( $obj->integer, 12, 'Subtract three for 12' );
  88
  89         throws_ok { $obj->sub( 10, 2 ) }
  90         qr/Cannot call sub with more than 1 argument/,
  91             'sub throws an error when 2 arguments are passed';
  92
  93         $obj->set(10);
  94
  95         is( $obj->integer, 10, 'Set to ten' );
  96
  97         throws_ok { $obj->set( 10, 2 ) }
  98         qr/Cannot call set with more than 1 argument/,
  99             'set throws an error when 2 arguments are passed';
 100
 101         $obj->div(2);
 102
 103         is( $obj->integer, 5, 'divide by 2' );
 104
 105         throws_ok { $obj->div( 10, 2 ) }
 106         qr/Cannot call div with more than 1 argument/,
 107             'div throws an error when 2 arguments are passed';
 108
 109         $obj->mul(2);
 110
 111         is( $obj->integer, 10, 'multiplied by 2' );
 112
 113         throws_ok { $obj->mul( 10, 2 ) }
 114         qr/Cannot call mul with more than 1 argument/,
 115             'mul throws an error when 2 arguments are passed';
 116
 117         $obj->mod(2);
 118
 119         is( $obj->integer, 0, 'Mod by 2' );
 120
 121         throws_ok { $obj->mod( 10, 2 ) }
 122         qr/Cannot call mod with more than 1 argument/,
 123             'mod throws an error when 2 arguments are passed';
 124
 125         $obj->set(7);
 126
 127         $obj->mod(5);
 128
 129         is( $obj->integer, 2, 'Mod by 5' );
 130
 131         $obj->set(-1);
 132
 133         $obj->abs;
 134
 135         throws_ok { $obj->abs(10) }
 136         qr/Cannot call abs with any arguments/,
 137             'abs throws an error when an argument is passed';
 138
 139         is( $obj->integer, 1, 'abs 1' );
 140
 141         $obj->set(12);
 142
 143         $obj->inc;
 144
 145         is( $obj->integer, 13, 'inc 12' );
 146
 147         $obj->dec;
 148
 149         is( $obj->integer, 12, 'dec 13' );
 150
 151         if ( $class->meta->get_attribute('integer')->is_lazy ) {
 152             my $obj = $class->new;
 153
 154             $obj->add(2);
 155
 156             is( $obj->integer, 7, 'add with lazy default' );
 157
 158             $obj->_clear_integer;
 159
 160             $obj->mod(2);
 161
 162             is( $obj->integer, 1, 'mod with lazy default' );
 163         }
 164     }
 165     $class;
 166 }
 167
 168 done_testing;