t/constructor.t

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