summaryrefslogtreecommitdiff
path: root/t/native_traits/trait_counter.t
diff options
context:
space:
mode:
Diffstat (limited to 't/native_traits/trait_counter.t')
-rw-r--r--t/native_traits/trait_counter.t170
1 files changed, 170 insertions, 0 deletions
diff --git a/t/native_traits/trait_counter.t b/t/native_traits/trait_counter.t
new file mode 100644
index 0000000..9a9901c
--- /dev/null
+++ b/t/native_traits/trait_counter.t
@@ -0,0 +1,170 @@
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use Moose ();
+use Moose::Util::TypeConstraints;
+use NoInlineAttribute;
+use Test::Fatal;
+use Test::More;
+use Test::Moose;
+
+{
+ my %handles = (
+ inc_counter => 'inc',
+ inc_counter_2 => [ inc => 2 ],
+ dec_counter => 'dec',
+ dec_counter_2 => [ dec => 2 ],
+ reset_counter => 'reset',
+ set_counter => 'set',
+ set_counter_42 => [ set => 42 ],
+ );
+
+ my $name = 'Foo1';
+
+ sub build_class {
+ my %attr = @_;
+
+ my $class = Moose::Meta::Class->create(
+ $name++,
+ superclasses => ['Moose::Object'],
+ );
+
+ my @traits = 'Counter';
+ push @traits, 'NoInlineAttribute'
+ if delete $attr{no_inline};
+
+ $class->add_attribute(
+ counter => (
+ traits => \@traits,
+ is => 'ro',
+ isa => 'Int',
+ default => 0,
+ handles => \%handles,
+ clearer => '_clear_counter',
+ %attr,
+ ),
+ );
+
+ return ( $class->name, \%handles );
+ }
+}
+
+{
+ run_tests(build_class);
+ run_tests( build_class( lazy => 1 ) );
+ run_tests( build_class( trigger => sub { } ) );
+ run_tests( build_class( no_inline => 1 ) );
+
+ # Will force the inlining code to check the entire hashref when it is modified.
+ subtype 'MyInt', as 'Int', where { 1 };
+
+ run_tests( build_class( isa => 'MyInt' ) );
+
+ coerce 'MyInt', from 'Int', via { $_ };
+
+ run_tests( build_class( isa => 'MyInt', coerce => 1 ) );
+}
+
+sub run_tests {
+ my ( $class, $handles ) = @_;
+
+ can_ok( $class, $_ ) for sort keys %{$handles};
+
+ with_immutable {
+ my $obj = $class->new();
+
+ is( $obj->counter, 0, '... got the default value' );
+
+ is( $obj->inc_counter, 1, 'inc returns new value' );
+ is( $obj->counter, 1, '... got the incremented value' );
+
+ is( $obj->inc_counter, 2, 'inc returns new value' );
+ is( $obj->counter, 2, '... got the incremented value (again)' );
+
+ like( exception { $obj->inc_counter( 1, 2 ) }, qr/Cannot call inc with more than 1 argument/, 'inc throws an error when two arguments are passed' );
+
+ is( $obj->dec_counter, 1, 'dec returns new value' );
+ is( $obj->counter, 1, '... got the decremented value' );
+
+ like( exception { $obj->dec_counter( 1, 2 ) }, qr/Cannot call dec with more than 1 argument/, 'dec throws an error when two arguments are passed' );
+
+ is( $obj->reset_counter, 0, 'reset returns new value' );
+ is( $obj->counter, 0, '... got the original value' );
+
+ like( exception { $obj->reset_counter(2) }, qr/Cannot call reset with any arguments/, 'reset throws an error when an argument is passed' );
+
+ is( $obj->set_counter(5), 5, 'set returns new value' );
+ is( $obj->counter, 5, '... set the value' );
+
+ like( exception { $obj->set_counter( 1, 2 ) }, qr/Cannot call set with more than 1 argument/, 'set throws an error when two arguments are passed' );
+
+ $obj->inc_counter(2);
+ is( $obj->counter, 7, '... increment by arg' );
+
+ $obj->dec_counter(5);
+ is( $obj->counter, 2, '... decrement by arg' );
+
+ $obj->inc_counter_2;
+ is( $obj->counter, 4, '... curried increment' );
+
+ $obj->dec_counter_2;
+ is( $obj->counter, 2, '... curried deccrement' );
+
+ $obj->set_counter_42;
+ is( $obj->counter, 42, '... curried set' );
+
+ if ( $class->meta->get_attribute('counter')->is_lazy ) {
+ my $obj = $class->new;
+
+ $obj->inc_counter;
+ is( $obj->counter, 1, 'inc increments - with lazy default' );
+
+ $obj->_clear_counter;
+
+ $obj->dec_counter;
+ is( $obj->counter, -1, 'dec decrements - with lazy default' );
+ }
+ }
+ $class;
+}
+
+{
+ package WithBuilder;
+ use Moose;
+
+ has nonlazy => (
+ traits => ['Counter'],
+ is => 'rw',
+ isa => 'Int',
+ builder => '_builder',
+ handles => {
+ reset_nonlazy => 'reset',
+ },
+ );
+
+ has lazy => (
+ traits => ['Counter'],
+ is => 'rw',
+ isa => 'Int',
+ lazy => 1,
+ builder => '_builder',
+ handles => {
+ reset_lazy => 'reset',
+ },
+ );
+
+ sub _builder { 1 }
+}
+
+for my $attr ('lazy', 'nonlazy') {
+ my $obj = WithBuilder->new;
+ is($obj->$attr, 1, "built properly");
+ $obj->$attr(0);
+ is($obj->$attr, 0, "can be manually set");
+ $obj->${\"reset_$attr"};
+ is($obj->$attr, 1, "reset resets it to its default value");
+}
+
+done_testing;