t/constructor.t

   1 #use Test::More;
   2 use Test::Most 'die';
   3 use Test::Fatal;
   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 sub do_tests
  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     {
  62         my $obj = Foo->new(attr1 => undef);
  63         ok(!$obj->has_attr1, 'UT attr1 has no value when assigned undef in constructor');
  64         isnt (exception { $obj = Foo->new(attr2 => undef) }, undef,
  65             'But assigning undef to attr2 generates a type constraint error');
  66
  67         is (exception { $obj = Foo->new(attr3 => undef) }, undef,
  68             'assigning undef to attr3 is acceptable');
  69         ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor');
  70     }
  71
  72     {
  73         my $obj = Foo->new(attr1 => 1234, attr2 => 5678, attr3 => 9012);
  74         is($obj->attr1, 1234, 'assigning a defined value during construction works as normal');
  75         ok($obj->has_attr1, '...and the predicate returns true as normal');
  76
  77         is($obj->attr2, 5678, 'assigning a defined value during construction works as normal');
  78         ok($obj->has_attr2, '...and the predicate returns true as normal');
  79
  80         is($obj->attr3, 9012, 'assigning a defined value during construction works as normal');
  81         ok($obj->has_attr3, '...and the predicate returns true as normal');
  82     }
  83
  84
  85     note '';
  86     note 'Testing class with the entire class being UndefTolerant';
  87     {
  88         my $obj = Bar->new;
  89         ok(!$obj->has_attr1, 'attr1 has no value before it is assigned');
  90         ok(!$obj->has_attr2, 'attr2 has no value before it is assigned');
  91         ok(!$obj->has_attr3, 'attr3 has no value before it is assigned');
  92     }
  93
  94     {
  95         my $obj = Bar->new(attr1 => undef);
  96         ok(!$obj->has_attr1, 'attr1 has no value when assigned undef in constructor');
  97         # note this test differs from the Foo case above
  98         is (exception { $obj = Bar->new(attr2 => undef) }, undef,
  99             'assigning undef to attr2 does not produce an error');
 100         ok(!$obj->has_attr2, 'attr2 has no value when assigned undef in constructor');
 101
 102         is( exception { $obj = Foo->new(attr3 => undef) }, undef,
 103             'assigning undef to attr3 is acceptable');
 104         ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor');
 105     }
 106
 107     {
 108         my $obj = Bar->new(attr1 => 1234, attr2 => 5678, attr3 => 9012);
 109         is($obj->attr1, 1234, 'assigning a defined value during construction works as normal');
 110         ok($obj->has_attr1, '...and the predicate returns true as normal');
 111
 112         is($obj->attr2, 5678, 'assigning a defined value during construction works as normal');
 113         ok($obj->has_attr2, '...and the predicate returns true as normal');
 114
 115         is($obj->attr3, 9012, 'assigning a defined value during construction works as normal');
 116         ok($obj->has_attr3, '...and the predicate returns true as normal');
 117     }
 118 }
 119
 120
 121 note 'Constructor behaviour: mutable classes';
 122 note '';
 123 do_tests;
 124
 125 note '';
 126 note 'Constructor behaviour: immutable classes';
 127 note '';
 128 Foo->meta->make_immutable;
 129 Bar->meta->make_immutable;
 130 TODO: {
 131     local $TODO = 'some immutable cases are not handled yet';
 132     # for now, catch errors
 133     is(exception { do_tests }, undef, 'tests do not die');
 134
 135     is(Test::More->builder->current_test, 28, 'if we got here, we can declare victory!');
 136 }
 137
 138 done_testing;
 139