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