More tests for Counter trait
[gitmo/Moose.git] / t / 070_native_traits / 001_trait_counter.t
CommitLineData
e3c07b19 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
baf3ece5 6use Moose ();
8b0c0c9d 7use Test::Exception;
a28e50e4 8use Test::More;
8b0c0c9d 9use Test::Moose;
e3c07b19 10
ed3ec87c 11my %handles = (
12 inc_counter => 'inc',
13 inc_counter_2 => [ inc => 2 ],
14 dec_counter => 'dec',
15 dec_counter_2 => [ dec => 2 ],
16 reset_counter => 'reset',
17 set_counter => 'set',
18 set_counter_42 => [ set => 42 ],
19);
20
e3c07b19 21{
baf3ece5 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}
8b0c0c9d 47
baf3ece5 48{
49 run_tests(build_class);
50 run_tests(build_class(lazy => 1));
e3c07b19 51}
52
baf3ece5 53sub run_tests {
54 my ( $class, $handles ) = @_;
55
56 can_ok( $class, $_ ) for sort keys %{$handles};
57 with_immutable {
58 my $obj = $class->new();
59
60 is( $obj->counter, 0, '... got the default value' );
61
62 $obj->inc_counter;
63 is( $obj->counter, 1, '... got the incremented value' );
64
65 $obj->inc_counter;
66 is( $obj->counter, 2, '... got the incremented value (again)' );
8b0c0c9d 67
baf3ece5 68 throws_ok { $obj->inc_counter( 1, 2 ) }
69 qr/Cannot call inc with more than 1 argument/,
70 'inc throws an error when two arguments are passed';
8b0c0c9d 71
baf3ece5 72 $obj->dec_counter;
73 is( $obj->counter, 1, '... got the decremented value' );
e3c07b19 74
baf3ece5 75 throws_ok { $obj->dec_counter( 1, 2 ) }
76 qr/Cannot call dec with more than 1 argument/,
77 'dec throws an error when two arguments are passed';
e3c07b19 78
baf3ece5 79 $obj->reset_counter;
80 is( $obj->counter, 0, '... got the original value' );
e3c07b19 81
baf3ece5 82 throws_ok { $obj->reset_counter(2) }
83 qr/Cannot call reset with any arguments/,
84 'reset throws an error when an argument is passed';
e3c07b19 85
baf3ece5 86 $obj->set_counter(5);
87 is( $obj->counter, 5, '... set the value' );
e3c07b19 88
baf3ece5 89 throws_ok { $obj->set_counter( 1, 2 ) }
90 qr/Cannot call set with more than 1 argument/,
91 'set throws an error when two arguments are passed';
e3c07b19 92
baf3ece5 93 $obj->inc_counter(2);
94 is( $obj->counter, 7, '... increment by arg' );
e3c07b19 95
baf3ece5 96 $obj->dec_counter(5);
97 is( $obj->counter, 2, '... decrement by arg' );
59de9de4 98
baf3ece5 99 $obj->inc_counter_2;
100 is( $obj->counter, 4, '... curried increment' );
59de9de4 101
baf3ece5 102 $obj->dec_counter_2;
103 is( $obj->counter, 2, '... curried deccrement' );
59de9de4 104
baf3ece5 105 $obj->set_counter_42;
106 is( $obj->counter, 42, '... curried set' );
e3c07b19 107
baf3ece5 108 if ( $class->meta->get_attribute('counter')->is_lazy ) {
109 my $obj = $class->new;
d50fc84a 110
baf3ece5 111 $obj->inc_counter;
112 is( $obj->counter, 1, 'inc increments - with lazy default' );
8b0c0c9d 113
baf3ece5 114 $obj->_clear_counter;
8b0c0c9d 115
baf3ece5 116 $obj->dec_counter;
117 is( $obj->counter, -1, 'dec decrements - with lazy default' );
118 }
119 }
120 $class;
8b0c0c9d 121}
e3c07b19 122
a28e50e4 123done_testing;