t/defaults.t

   1 use Test::More;
   2 use Test::Fatal;
   3 use Test::Moose;
   4
   5 use MooseX::UndefTolerant::Attribute ();
   6
   7 {
   8     package Foo;
   9     use Moose;
  10
  11     has 'attr1' => (
  12         traits => [ qw(MooseX::UndefTolerant::Attribute)],
  13         is => 'ro',
  14         isa => 'Num',
  15         predicate => 'has_attr1',
  16         default => 1,
  17     );
  18     has 'attr2' => (
  19         is => 'ro',
  20         isa => 'Num',
  21         predicate => 'has_attr2',
  22         default => 2,
  23     );
  24     has 'attr3' => (
  25         is => 'ro',
  26         isa => 'Maybe[Num]',
  27         predicate => 'has_attr3',
  28         default => 3,
  29     );
  30 }
  31
  32 {
  33     package Bar;
  34     use Moose;
  35     use MooseX::UndefTolerant;
  36
  37     has 'attr1' => (
  38         is => 'ro',
  39         isa => 'Num',
  40         predicate => 'has_attr1',
  41         default => 1,
  42     );
  43     has 'attr2' => (
  44         is => 'ro',
  45         isa => 'Num',
  46         predicate => 'has_attr2',
  47         default => 2,
  48     );
  49     has 'attr3' => (
  50         is => 'ro',
  51         isa => 'Maybe[Num]',
  52         predicate => 'has_attr3',
  53         default => 3,
  54     );
  55 }
  56
  57
  58 package main;
  59
  60 sub do_tests
  61 {
  62     note 'Default behaviour: ',
  63         (Foo->meta->is_immutable ? 'im' : '') . 'mutable classes', "\n";
  64
  65     note 'Testing class with a single UndefTolerant attribute';
  66     do_tests_with_class('Foo');
  67
  68     note '';
  69     note 'Testing class with the entire class being UndefTolerant';
  70     do_tests_with_class('Bar');
  71 }
  72
  73 sub do_tests_with_class
  74 {
  75     my $class = shift;
  76
  77     {
  78         my $obj = $class->new;
  79         ok($obj->has_attr1, 'attr1 has a value');
  80         ok($obj->has_attr2, 'attr2 has a value');
  81         ok($obj->has_attr3, 'attr3 has a value');
  82
  83         is($obj->attr1, 1, 'attr1\'s value is its default');
  84         is($obj->attr2, 2, 'attr2\'s value is its default');
  85         is($obj->attr3, 3, 'attr3\'s value is its default');
  86     }
  87
  88     TODO: {
  89         my $e = exception {
  90             my $obj = $class->new(attr1 => undef, attr3 => undef);
  91             {
  92                 local $TODO = 'not sure why this fails still... needs attr trait rewrite' if $obj->meta->is_immutable;
  93                 # FIXME: the object is successfully constructed, and the value
  94                 # for attr1 is properly removed, but the default is not then
  95                 # used instead...
  96                 # note "### constructed object: ", $obj->dump(2);
  97                 ok($obj->has_attr1, 'UT attr1 has a value when assigned undef in constructor');
  98                 is($obj->attr1, 1, 'attr1\'s value is its default');
  99             }
 100             ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor');
 101
 102             is($obj->attr2, 2, 'attr2\'s value is its default');
 103             is($obj->attr3, undef, 'attr3\'s value is not its default (explicitly set)');
 104         };
 105         local $TODO = 'some immutable cases are not handled yet; see CAVEATS'
 106             if $class->meta->is_immutable and $class eq 'Foo';
 107
 108         is($e, undef, 'these tests do not die');
 109     }
 110
 111     {
 112         my $obj = $class->new(attr1 => 1234, attr2 => 5678, attr3 => 9012);
 113         is($obj->attr1, 1234, 'assigning a defined value during construction works as normal');
 114         ok($obj->has_attr1, '...and the predicate returns true as normal');
 115
 116         is($obj->attr2, 5678, 'assigning a defined value during construction works as normal');
 117         ok($obj->has_attr2, '...and the predicate returns true as normal');
 118
 119         is($obj->attr3, 9012, 'assigning a defined value during construction works as normal');
 120         ok($obj->has_attr3, '...and the predicate returns true as normal');
 121     }
 122 }
 123
 124 with_immutable {
 125     do_tests;
 126 } qw(Foo Bar);
 127
 128 TODO: {
 129     local $TODO = 'some cases are still not handled yet; see CAVEATS';
 130     is(Test::More->builder->current_test, 98, 'if we got here, we can declare victory!');
 131 }
 132
 133 done_testing;
 134