Remove our (now broken) dzil GatherDir subclass
[gitmo/Moose.git] / t / native_traits / trait_bool.t
CommitLineData
e3c07b19 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
8b9641b8 6use lib 't/lib';
7
26a79215 8use Moose ();
2c963694 9use Moose::Util::TypeConstraints;
8b9641b8 10use NoInlineAttribute;
a28e50e4 11use Test::More;
b10dde3a 12use Test::Fatal;
26a79215 13use Test::Moose;
e3c07b19 14
15{
26a79215 16 my %handles = (
17 illuminate => 'set',
18 darken => 'unset',
19 flip_switch => 'toggle',
20 is_dark => 'not',
21 );
22
23 my $name = 'Foo1';
24
25 sub build_class {
26 my %attr = @_;
27
28 my $class = Moose::Meta::Class->create(
29 $name++,
30 superclasses => ['Moose::Object'],
31 );
32
8b9641b8 33 my @traits = 'Bool';
34 push @traits, 'NoInlineAttribute'
35 if delete $attr{no_inline};
36
26a79215 37 $class->add_attribute(
38 is_lit => (
8b9641b8 39 traits => \@traits,
26a79215 40 is => 'rw',
41 isa => 'Bool',
42 default => 0,
43 handles => \%handles,
44 clearer => '_clear_is_list',
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 ) );
cf0da4e2 56 run_tests( build_class( trigger => sub { } ) );
8b9641b8 57 run_tests( build_class( no_inline => 1 ) );
2c963694 58
59 # Will force the inlining code to check the entire hashref when it is modified.
60 subtype 'MyBool', as 'Bool', where { 1 };
61
62 run_tests( build_class( isa => 'MyBool' ) );
63
64 coerce 'MyBool', from 'Bool', via { $_ };
65
66 run_tests( build_class( isa => 'MyBool', coerce => 1 ) );
e3c07b19 67}
68
26a79215 69sub run_tests {
70 my ( $class, $handles ) = @_;
e3c07b19 71
26a79215 72 can_ok( $class, $_ ) for sort keys %{$handles};
e3c07b19 73
26a79215 74 with_immutable {
75 my $obj = $class->new;
e3c07b19 76
7f5ec80d 77 ok( $obj->illuminate, 'set returns true' );
26a79215 78 ok( $obj->is_lit, 'set is_lit to 1 using ->illuminate' );
79 ok( !$obj->is_dark, 'check if is_dark does the right thing' );
80
b10dde3a 81 like( exception { $obj->illuminate(1) }, qr/Cannot call set with any arguments/, 'set throws an error when an argument is passed' );
26a79215 82
7f5ec80d 83 ok( !$obj->darken, 'unset returns false' );
26a79215 84 ok( !$obj->is_lit, 'set is_lit to 0 using ->darken' );
85 ok( $obj->is_dark, 'check if is_dark does the right thing' );
86
b10dde3a 87 like( exception { $obj->darken(1) }, qr/Cannot call unset with any arguments/, 'unset throws an error when an argument is passed' );
26a79215 88
7f5ec80d 89 ok( $obj->flip_switch, 'toggle returns new value' );
26a79215 90 ok( $obj->is_lit, 'toggle is_lit back to 1 using ->flip_switch' );
91 ok( !$obj->is_dark, 'check if is_dark does the right thing' );
92
b10dde3a 93 like( exception { $obj->flip_switch(1) }, qr/Cannot call toggle with any arguments/, 'toggle throws an error when an argument is passed' );
26a79215 94
95 $obj->flip_switch;
96 ok( !$obj->is_lit,
97 'toggle is_lit back to 0 again using ->flip_switch' );
98 ok( $obj->is_dark, 'check if is_dark does the right thing' );
99 }
100 $class;
101}
e3c07b19 102
a28e50e4 103done_testing;