t/defaults.t

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