Commit | Line | Data |
3991a5d2 |
1 | #use Test::More; |
2 | use Test::Most 'die'; |
8055a641 |
3 | use Test::Fatal; |
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 | { |
8055a641 |
62 | note 'Testing class with a single UndefTolerant attribute'; |
581c4a18 |
63 | do_tests_with_class('Foo'); |
8055a641 |
64 | |
65 | note ''; |
66 | note 'Testing class with the entire class being UndefTolerant'; |
581c4a18 |
67 | do_tests_with_class('Bar'); |
68 | } |
69 | |
70 | sub do_tests_with_class |
71 | { |
72 | my $class = shift; |
73 | |
8055a641 |
74 | { |
581c4a18 |
75 | my $obj = $class->new; |
8055a641 |
76 | ok($obj->has_attr1, 'attr1 has a value'); |
77 | ok($obj->has_attr2, 'attr2 has a value'); |
3991a5d2 |
78 | ok($obj->has_attr3, 'attr3 has a value'); |
79 | |
8055a641 |
80 | is($obj->attr1, 1, 'attr1\'s value is its default'); |
81 | is($obj->attr2, 2, 'attr2\'s value is its default'); |
3991a5d2 |
82 | is($obj->attr3, 3, 'attr3\'s value is its default'); |
8055a641 |
83 | } |
84 | |
85 | { |
3991a5d2 |
86 | my $obj = $class->new(attr1 => undef, attr3 => undef); |
8055a641 |
87 | ok($obj->has_attr1, 'UT attr1 has a value when assigned undef in constructor'); |
3991a5d2 |
88 | ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor'); |
89 | |
8055a641 |
90 | is($obj->attr1, 1, 'attr1\'s value is its default'); |
91 | is($obj->attr2, 2, 'attr2\'s value is its default'); |
3991a5d2 |
92 | is($obj->attr3, undef, 'attr3\'s value is not its default (explicitly set)'); |
8055a641 |
93 | } |
94 | |
95 | { |
3991a5d2 |
96 | my $obj = $class->new(attr1 => 1234, attr2 => 5678, attr3 => 9012); |
8055a641 |
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'); |
3991a5d2 |
99 | |
8055a641 |
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'); |
3991a5d2 |
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'); |
8055a641 |
105 | } |
36bf5c4d |
106 | } |
107 | |
8055a641 |
108 | note 'Default behaviour: mutable classes'; |
109 | note ''; |
110 | do_tests; |
36bf5c4d |
111 | |
112 | note ''; |
8055a641 |
113 | note 'Default behaviour: immutable classes'; |
114 | note ''; |
115 | Foo->meta->make_immutable; |
116 | Bar->meta->make_immutable; |
36bf5c4d |
117 | |
8055a641 |
118 | TODO: { |
119 | local $TODO = 'some immutable cases are not handled yet'; |
120 | # for now, catch errors |
015b9167 |
121 | is (exception { do_tests }, undef, 'tests do not die'); |
36bf5c4d |
122 | |
8055a641 |
123 | is(Test::More->builder->current_test, 44, 'if we got here, we can declare victory!'); |
36bf5c4d |
124 | } |
779ca481 |
125 | |
8055a641 |
126 | done_testing; |
127 | |