t/defaults.t

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