t/constructor.t

   1 use Test::More;
   2 use Test::Fatal;
   3 use Test::Moose;
   4
   5 {
   6     package Foo;
   7     use Moose;
   8
   9     has 'attr1' => (
  10         traits => [ qw(MooseX::UndefTolerant::Attribute)],
  11         is => 'ro',
  12         isa => 'Num',
  13         predicate => 'has_attr1',
  14     );
  15     has 'attr2' => (
  16         is => 'ro',
  17         isa => 'Num',
  18         predicate => 'has_attr2',
  19     );
  20     has 'attr3' => (
  21         is => 'ro',
  22         isa => 'Maybe[Num]',
  23         predicate => 'has_attr3',
  24     );
  25 }
  26
  27 {
  28     package Bar;
  29     use Moose;
  30     use MooseX::UndefTolerant;
  31
  32     has 'attr1' => (
  33         is => 'ro',
  34         isa => 'Num',
  35         predicate => 'has_attr1',
  36     );
  37     has 'attr2' => (
  38         is => 'ro',
  39         isa => 'Num',
  40         predicate => 'has_attr2',
  41     );
  42     has 'attr3' => (
  43         is => 'ro',
  44         isa => 'Maybe[Num]',
  45         predicate => 'has_attr3',
  46     );
  47 }
  48
  49 package main;
  50
  51 with_immutable
  52 {
  53     note 'Testing class with a single UndefTolerant attribute';
  54     {
  55         my $obj = Foo->new;
  56         ok(!$obj->has_attr1, 'attr1 has no value before it is assigned');
  57         ok(!$obj->has_attr2, 'attr2 has no value before it is assigned');
  58         ok(!$obj->has_attr3, 'attr3 has no value before it is assigned');
  59     }
  60
  61     TODO: {
  62         local $TODO;
  63         $TODO = 'some immutable cases are not handled yet; see CAVEATS' if Foo->meta->is_immutable;
  64         is(
  65             exception {
  66
  67                 my $obj = Foo->new(attr1 => undef);
  68                 ok(!$obj->has_attr1, 'UT attr1 has no value when assigned undef in constructor');
  69                 like(
  70                     exception { $obj = Foo->new(attr2 => undef) },
  71                     qr/\QAttribute (attr2) does not pass the type constraint because: Validation failed for 'Num' with value undef\E/,
  72                     'But assigning undef to attr2 generates a type constraint error');
  73
  74                 is (exception { $obj = Foo->new(attr3 => undef) }, undef,
  75                     'assigning undef to attr3 is acceptable');
  76                 ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor');
  77             },
  78             undef,
  79             'successfully tested spot-applicaction of UT trait in immutable classes',
  80         );
  81     }
  82
  83     {
  84         my $obj = Foo->new(attr1 => 1234, attr2 => 5678, attr3 => 9012);
  85         is($obj->attr1, 1234, 'assigning a defined value during construction works as normal');
  86         ok($obj->has_attr1, '...and the predicate returns true as normal');
  87
  88         is($obj->attr2, 5678, 'assigning a defined value during construction works as normal');
  89         ok($obj->has_attr2, '...and the predicate returns true as normal');
  90
  91         is($obj->attr3, 9012, 'assigning a defined value during construction works as normal');
  92         ok($obj->has_attr3, '...and the predicate returns true as normal');
  93     }
  94
  95
  96     note '';
  97     note 'Testing class with the entire class being UndefTolerant';
  98     {
  99         my $obj = Bar->new;
 100         ok(!$obj->has_attr1, 'attr1 has no value before it is assigned');
 101         ok(!$obj->has_attr2, 'attr2 has no value before it is assigned');
 102         ok(!$obj->has_attr3, 'attr3 has no value before it is assigned');
 103     }
 104
 105     {
 106         my $obj = Bar->new(attr1 => undef);
 107         ok(!$obj->has_attr1, 'attr1 has no value when assigned undef in constructor');
 108         # note this test differs from the Foo case above
 109         is (exception { $obj = Bar->new(attr2 => undef) }, undef,
 110             'assigning undef to attr2 does not produce an error');
 111         ok(!$obj->has_attr2, 'attr2 has no value when assigned undef in constructor');
 112
 113         is( exception { $obj = Foo->new(attr3 => undef) }, undef,
 114             'assigning undef to attr3 is acceptable');
 115         ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor');
 116     }
 117
 118     {
 119         my $obj = Bar->new(attr1 => 1234, attr2 => 5678, attr3 => 9012);
 120         is($obj->attr1, 1234, 'assigning a defined value during construction works as normal');
 121         ok($obj->has_attr1, '...and the predicate returns true as normal');
 122
 123         is($obj->attr2, 5678, 'assigning a defined value during construction works as normal');
 124         ok($obj->has_attr2, '...and the predicate returns true as normal');
 125
 126         is($obj->attr3, 9012, 'assigning a defined value during construction works as normal');
 127         ok($obj->has_attr3, '...and the predicate returns true as normal');
 128     }
 129 }
 130 qw(Foo Bar);
 131
 132 note 'Ran ', Test::More->builder->current_test, ' tests - should have run 56';
 133
 134 done_testing;
 135