t/defaults.t

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