Commit | Line | Data |
4fbe5d7d |
1 | use strict; |
2 | use warnings; |
3 | |
0dd9c65b |
4 | use Test::More; |
8055a641 |
5 | use Test::Fatal; |
29506dff |
6 | use Test::Moose; |
779ca481 |
7 | |
36bf5c4d |
8 | use MooseX::UndefTolerant::Attribute (); |
779ca481 |
9 | |
36bf5c4d |
10 | { |
11 | package Foo; |
12 | use Moose; |
779ca481 |
13 | |
36bf5c4d |
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 | ); |
3991a5d2 |
27 | has 'attr3' => ( |
28 | is => 'ro', |
29 | isa => 'Maybe[Num]', |
30 | predicate => 'has_attr3', |
31 | default => 3, |
32 | ); |
36bf5c4d |
33 | } |
779ca481 |
34 | |
36bf5c4d |
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 | ); |
3991a5d2 |
52 | has 'attr3' => ( |
53 | is => 'ro', |
54 | isa => 'Maybe[Num]', |
55 | predicate => 'has_attr3', |
56 | default => 3, |
57 | ); |
36bf5c4d |
58 | } |
779ca481 |
59 | |
779ca481 |
60 | |
61 | package main; |
62 | |
8055a641 |
63 | sub do_tests |
36bf5c4d |
64 | { |
29506dff |
65 | note 'Default behaviour: ', |
66 | (Foo->meta->is_immutable ? 'im' : '') . 'mutable classes', "\n"; |
67 | |
8055a641 |
68 | note 'Testing class with a single UndefTolerant attribute'; |
581c4a18 |
69 | do_tests_with_class('Foo'); |
8055a641 |
70 | |
71 | note ''; |
72 | note 'Testing class with the entire class being UndefTolerant'; |
581c4a18 |
73 | do_tests_with_class('Bar'); |
74 | } |
75 | |
76 | sub do_tests_with_class |
77 | { |
78 | my $class = shift; |
79 | |
8055a641 |
80 | { |
581c4a18 |
81 | my $obj = $class->new; |
8055a641 |
82 | ok($obj->has_attr1, 'attr1 has a value'); |
83 | ok($obj->has_attr2, 'attr2 has a value'); |
3991a5d2 |
84 | ok($obj->has_attr3, 'attr3 has a value'); |
85 | |
8055a641 |
86 | is($obj->attr1, 1, 'attr1\'s value is its default'); |
87 | is($obj->attr2, 2, 'attr2\'s value is its default'); |
3991a5d2 |
88 | is($obj->attr3, 3, 'attr3\'s value is its default'); |
8055a641 |
89 | } |
90 | |
29506dff |
91 | TODO: { |
29506dff |
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; |
19b920ae |
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); |
29506dff |
100 | ok($obj->has_attr1, 'UT attr1 has a value when assigned undef in constructor'); |
29506dff |
101 | is($obj->attr1, 1, 'attr1\'s value is its default'); |
102 | } |
377fd470 |
103 | ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor'); |
29506dff |
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 | }; |
19b920ae |
108 | local $TODO = 'some immutable cases are not handled yet; see CAVEATS' |
29506dff |
109 | if $class->meta->is_immutable and $class eq 'Foo'; |
110 | |
111 | is($e, undef, 'these tests do not die'); |
8055a641 |
112 | } |
113 | |
114 | { |
3991a5d2 |
115 | my $obj = $class->new(attr1 => 1234, attr2 => 5678, attr3 => 9012); |
8055a641 |
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'); |
3991a5d2 |
118 | |
8055a641 |
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'); |
3991a5d2 |
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'); |
8055a641 |
124 | } |
36bf5c4d |
125 | } |
126 | |
29506dff |
127 | with_immutable { |
128 | do_tests; |
129 | } qw(Foo Bar); |
36bf5c4d |
130 | |
8055a641 |
131 | TODO: { |
29506dff |
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!'); |
36bf5c4d |
134 | } |
779ca481 |
135 | |
8055a641 |
136 | done_testing; |
137 | |