Add explicit return values for (almost) all native delegation mutating methods
[gitmo/Moose.git] / t / 070_native_traits / 040_trait_counter.t
CommitLineData
e3c07b19 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
8b9641b8 6use lib 't/lib';
7
baf3ece5 8use Moose ();
2c963694 9use Moose::Util::TypeConstraints;
8b9641b8 10use NoInlineAttribute;
8b0c0c9d 11use Test::Exception;
a28e50e4 12use Test::More;
8b0c0c9d 13use Test::Moose;
e3c07b19 14
e3c07b19 15{
24d9c065 16 my %handles = (
17 inc_counter => 'inc',
18 inc_counter_2 => [ inc => 2 ],
19 dec_counter => 'dec',
20 dec_counter_2 => [ dec => 2 ],
21 reset_counter => 'reset',
22 set_counter => 'set',
23 set_counter_42 => [ set => 42 ],
24 );
25
baf3ece5 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
8b9641b8 36 my @traits = 'Counter';
37 push @traits, 'NoInlineAttribute'
38 if delete $attr{no_inline};
39
baf3ece5 40 $class->add_attribute(
41 counter => (
8b9641b8 42 traits => \@traits,
baf3ece5 43 is => 'ro',
44 isa => 'Int',
45 default => 0,
46 handles => \%handles,
47 clearer => '_clear_counter',
48 %attr,
49 ),
50 );
51
52 return ( $class->name, \%handles );
53 }
54}
8b0c0c9d 55
baf3ece5 56{
57 run_tests(build_class);
24d9c065 58 run_tests( build_class( lazy => 1 ) );
cf0da4e2 59 run_tests( build_class( trigger => sub { } ) );
8b9641b8 60 run_tests( build_class( no_inline => 1 ) );
2c963694 61
62 # Will force the inlining code to check the entire hashref when it is modified.
63 subtype 'MyInt', as 'Int', where { 1 };
64
65 run_tests( build_class( isa => 'MyInt' ) );
66
67 coerce 'MyInt', from 'Int', via { $_ };
68
69 run_tests( build_class( isa => 'MyInt', coerce => 1 ) );
e3c07b19 70}
71
baf3ece5 72sub run_tests {
73 my ( $class, $handles ) = @_;
74
75 can_ok( $class, $_ ) for sort keys %{$handles};
24d9c065 76
baf3ece5 77 with_immutable {
78 my $obj = $class->new();
79
80 is( $obj->counter, 0, '... got the default value' );
81
7f5ec80d 82 is( $obj->inc_counter, 1, 'inc returns new value' );
baf3ece5 83 is( $obj->counter, 1, '... got the incremented value' );
84
7f5ec80d 85 is( $obj->inc_counter, 2, 'inc returns new value' );
baf3ece5 86 is( $obj->counter, 2, '... got the incremented value (again)' );
8b0c0c9d 87
baf3ece5 88 throws_ok { $obj->inc_counter( 1, 2 ) }
89 qr/Cannot call inc with more than 1 argument/,
90 'inc throws an error when two arguments are passed';
8b0c0c9d 91
7f5ec80d 92 is( $obj->dec_counter, 1, 'dec returns new value' );
baf3ece5 93 is( $obj->counter, 1, '... got the decremented value' );
e3c07b19 94
baf3ece5 95 throws_ok { $obj->dec_counter( 1, 2 ) }
96 qr/Cannot call dec with more than 1 argument/,
97 'dec throws an error when two arguments are passed';
e3c07b19 98
7f5ec80d 99 is( $obj->reset_counter, 0, 'reset returns new value' );
baf3ece5 100 is( $obj->counter, 0, '... got the original value' );
e3c07b19 101
baf3ece5 102 throws_ok { $obj->reset_counter(2) }
103 qr/Cannot call reset with any arguments/,
104 'reset throws an error when an argument is passed';
e3c07b19 105
7f5ec80d 106 is( $obj->set_counter(5), 5, 'set returns new value' );
baf3ece5 107 is( $obj->counter, 5, '... set the value' );
e3c07b19 108
baf3ece5 109 throws_ok { $obj->set_counter( 1, 2 ) }
110 qr/Cannot call set with more than 1 argument/,
111 'set throws an error when two arguments are passed';
e3c07b19 112
baf3ece5 113 $obj->inc_counter(2);
114 is( $obj->counter, 7, '... increment by arg' );
e3c07b19 115
baf3ece5 116 $obj->dec_counter(5);
117 is( $obj->counter, 2, '... decrement by arg' );
59de9de4 118
baf3ece5 119 $obj->inc_counter_2;
120 is( $obj->counter, 4, '... curried increment' );
59de9de4 121
baf3ece5 122 $obj->dec_counter_2;
123 is( $obj->counter, 2, '... curried deccrement' );
59de9de4 124
baf3ece5 125 $obj->set_counter_42;
126 is( $obj->counter, 42, '... curried set' );
e3c07b19 127
baf3ece5 128 if ( $class->meta->get_attribute('counter')->is_lazy ) {
129 my $obj = $class->new;
d50fc84a 130
baf3ece5 131 $obj->inc_counter;
132 is( $obj->counter, 1, 'inc increments - with lazy default' );
8b0c0c9d 133
baf3ece5 134 $obj->_clear_counter;
8b0c0c9d 135
baf3ece5 136 $obj->dec_counter;
137 is( $obj->counter, -1, 'dec decrements - with lazy default' );
138 }
139 }
140 $class;
8b0c0c9d 141}
e3c07b19 142
a28e50e4 143done_testing;