t/constructor.t

   1 use Test::More tests => 14;
   2 use Test::Fatal;
   3
   4 # TODO: this test should be renamed constructor.t, since all it tests is
   5 # UT behaviour during construction.
   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     );
  17
  18     has 'attr2' => (
  19         is => 'ro',
  20         isa => 'Num',
  21         predicate => 'has_attr2',
  22     );
  23 }
  24
  25 {
  26     package Bar;
  27     use Moose;
  28     use MooseX::UndefTolerant;
  29
  30     has 'attr1' => (
  31         is => 'ro',
  32         isa => 'Num',
  33         predicate => 'has_attr1',
  34     );
  35     has 'attr2' => (
  36         is => 'ro',
  37         isa => 'Num',
  38         predicate => 'has_attr2',
  39     );
  40 }
  41
  42 package main;
  43
  44 note 'Constructor behaviour';
  45 note '';
  46
  47 note 'Testing class with a single UndefTolerant attribute';
  48 {
  49     my $obj = Foo->new;
  50     ok(!$obj->has_attr1, 'attr1 has no value before it is assigned');
  51     ok(!$obj->has_attr2, 'attr2 has no value before it is assigned');
  52 }
  53
  54 {
  55     my $obj = Foo->new(attr1 => undef);
  56     ok(!$obj->has_attr1, 'UT attr1 has no value when assigned undef in constructor');
  57     ok (exception { $obj = Foo->new(attr2 => undef) },
  58         'But assigning undef to attr2 generates a type constraint error');
  59 }
  60
  61 {
  62     my $obj = Foo->new(attr1 => 1234, attr2 => 5678);
  63     is($obj->attr1, 1234, 'assigning a defined value during construction works as normal');
  64     ok($obj->has_attr1, '...and the predicate returns true as normal');
  65     is($obj->attr2, 5678, 'assigning a defined value during construction works as normal');
  66     ok($obj->has_attr2, '...and the predicate returns true as normal');
  67 }
  68
  69
  70 note '';
  71 note 'Testing class with the entire class being UndefTolerant';
  72 {
  73     my $obj = Bar->new;
  74     ok(!$obj->has_attr1, 'attr1 has no value before it is assigned');
  75 }
  76
  77 {
  78     my $obj = Bar->new(attr1 => undef);
  79     ok(!$obj->has_attr1, 'attr1 has no value when assigned undef in constructor');
  80     ok (!exception { $obj = Bar->new(attr2 => undef) },
  81         'assigning undef to attr2 does not produce an error');
  82     ok(!$obj->has_attr2, 'attr2 has no value when assigned undef in constructor');
  83 }
  84
  85 {
  86     my $obj = Bar->new(attr1 => 1234);
  87     is($obj->attr1, 1234, 'assigning a defined value during construction works as normal');
  88     ok($obj->has_attr1, '...and the predicate returns true as normal');
  89 }
  90
  91