t/070_native_traits/020_trait_bool.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Moose ();
   7 use Moose::Util::TypeConstraints;
   8 use Test::More;
   9 use Test::Exception;
  10 use Test::Moose;
  11
  12 {
  13     my %handles = (
  14         illuminate  => 'set',
  15         darken      => 'unset',
  16         flip_switch => 'toggle',
  17         is_dark     => 'not',
  18     );
  19
  20     my $name = 'Foo1';
  21
  22     sub build_class {
  23         my %attr = @_;
  24
  25         my $class = Moose::Meta::Class->create(
  26             $name++,
  27             superclasses => ['Moose::Object'],
  28         );
  29
  30         $class->add_attribute(
  31             is_lit => (
  32                 traits  => ['Bool'],
  33                 is      => 'rw',
  34                 isa     => 'Bool',
  35                 default => 0,
  36                 handles => \%handles,
  37                 clearer => '_clear_is_list',
  38                 %attr,
  39             ),
  40         );
  41
  42         return ( $class->name, \%handles );
  43     }
  44 }
  45
  46 {
  47     run_tests(build_class);
  48     run_tests( build_class( lazy => 1 ) );
  49
  50     # Will force the inlining code to check the entire hashref when it is modified.
  51     subtype 'MyBool', as 'Bool', where { 1 };
  52
  53     run_tests( build_class( isa => 'MyBool' ) );
  54
  55     coerce 'MyBool', from 'Bool', via { $_ };
  56
  57     run_tests( build_class( isa => 'MyBool', coerce => 1 ) );
  58 }
  59
  60 sub run_tests {
  61     my ( $class, $handles ) = @_;
  62
  63     can_ok( $class, $_ ) for sort keys %{$handles};
  64
  65     with_immutable {
  66         my $obj = $class->new;
  67
  68         $obj->illuminate;
  69         ok( $obj->is_lit,   'set is_lit to 1 using ->illuminate' );
  70         ok( !$obj->is_dark, 'check if is_dark does the right thing' );
  71
  72         throws_ok { $obj->illuminate(1) }
  73         qr/Cannot call set with any arguments/,
  74             'set throws an error when an argument is passed';
  75
  76         $obj->darken;
  77         ok( !$obj->is_lit, 'set is_lit to 0 using ->darken' );
  78         ok( $obj->is_dark, 'check if is_dark does the right thing' );
  79
  80         throws_ok { $obj->darken(1) }
  81         qr/Cannot call unset with any arguments/,
  82             'unset throws an error when an argument is passed';
  83
  84         $obj->flip_switch;
  85         ok( $obj->is_lit,   'toggle is_lit back to 1 using ->flip_switch' );
  86         ok( !$obj->is_dark, 'check if is_dark does the right thing' );
  87
  88         throws_ok { $obj->flip_switch(1) }
  89         qr/Cannot call toggle with any arguments/,
  90             'toggle throws an error when an argument is passed';
  91
  92         $obj->flip_switch;
  93         ok( !$obj->is_lit,
  94             'toggle is_lit back to 0 again using ->flip_switch' );
  95         ok( $obj->is_dark, 'check if is_dark does the right thing' );
  96     }
  97     $class;
  98 }
  99
 100 done_testing;