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