Deprecate clone_instance
[gitmo/Mouse.git] / t / 023-builder.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 47;
5 use Test::Exception;
6
7 my $builder_called = 0;
8 my $lazy_builder_called = 0;
9
10 do {
11     package Class;
12     use Mouse;
13
14     has name => (
15         is        => 'rw',
16         isa       => 'Str',
17         builder   => '_build_name',
18         predicate => 'has_name',
19         clearer   => 'clear_name',
20     );
21
22     sub _build_name {
23         my $self = shift;
24         ++$builder_called;
25         return "FRANK";
26     };
27
28     has age => (
29         is         => 'ro',
30         isa        => 'Int',
31         lazy_build => 1,
32         clearer    => 'clear_age',
33         predicate  => 'has_age',
34     );
35
36     sub default_age { 20 }
37     sub _build_age {
38         my $self = shift;
39         ++$lazy_builder_called;
40         return $self->default_age;
41     };
42
43 };
44
45 # eager builder
46 my $object = Class->new(name => "Bob");
47 ok($object->has_name, "predicate: value from constructor");
48 is($builder_called, 0, "builder not called in the constructor when we pass a value");
49 is($object->name, "Bob", "builder doesn't matter when we just set the value in constructor");
50 $object->name("Bill");
51 is($object->name, "Bill", "builder doesn't matter when we just set the value in writer");
52 is($builder_called, 0, "builder not called in the setter");
53 $builder_called = 0;
54
55 $object->clear_name;
56 ok(!$object->has_name, "predicate: no value after clear");
57 is($object->name, undef, "eager builder does NOT swoop in after clear");
58 ok(!$object->has_name, "predicate: no value after clear and get");
59 is($builder_called, 0, "builder not called in the getter, even after clear");
60 $builder_called = 0;
61
62 my $object2 = Class->new;
63 ok($object2->has_name, "predicate: value from eager builder");
64 is($object2->name, "FRANK", "builder called to provide the default value");
65 is($builder_called, 1, "builder called ONCE to provide the default value");
66
67 # lazy builder
68 my $object3 = Class->new;
69 is($lazy_builder_called, 0, "lazy builder not called yet");
70 ok(!$object3->has_age, "predicate: no age yet");
71 is($object3->age, 20, "lazy builder value");
72 ok($object3->has_age, "predicate: have value after get");
73 is($lazy_builder_called, 1, "lazy builder called on get");
74 is($object3->age, 20, "lazy builder value");
75 is($lazy_builder_called, 1, "lazy builder not called on subsequent gets");
76 ok($object3->has_age, "predicate: have value after subsequent gets");
77
78 $lazy_builder_called = 0;
79 $object3->clear_age;
80 ok(!$object3->has_age, "predicate: no value after clear");
81 is($lazy_builder_called, 0, "lazy builder not called on clear");
82 is($object3->age, 20, "lazy builder value");
83 ok($object3->has_age, "predicate: have value after clear and get");
84 is($lazy_builder_called, 1, "lazy builder called on get after clear");
85
86 $lazy_builder_called = 0;
87 my $object4 = Class->new(age => 50);
88 ok($object4->has_age, "predicate: have value from constructor");
89 is($lazy_builder_called, 0, "lazy builder not called yet");
90 is($object4->age, 50, "value from constructor");
91 is($lazy_builder_called, 0, "lazy builder not called if value is from constructor");
92
93 $object4->clear_age;
94 ok(!$object4->has_age, "predicate: no value after clear");
95 is($lazy_builder_called, 0, "lazy builder not called on clear");
96 is($object4->age, 20, "lazy builder value");
97 ok($object4->has_age, "predicate: have value after clear and get");
98 is($lazy_builder_called, 1, "lazy builder called on get after clear");
99
100 do {
101     package Class::Error;
102     use Mouse;
103
104     ::throws_ok {
105         has error => (
106             lazy_build => 1,
107             default => 1,
108         );
109     } qr/You can not use lazy_build and default for the same attribute \(error\)/;
110 };
111
112 my @calls;
113 do {
114     package Class::CustomBuilder;
115     use Mouse;
116
117     has custom => (
118         is => 'ro',
119         lazy_build => 1,
120         builder    => 'build_my_customs',
121         predicate  => 'has_my_customs',
122         clearer    => 'clear_my_customs',
123     );
124
125     sub build_my_customs {
126         push @calls, 'build_my_customs';
127         return 'yo';
128     }
129 };
130
131 my $cb = Class::CustomBuilder->new;
132 ok(!$cb->has_my_customs, "correct predicate");
133 is($cb->custom, 'yo');
134 is_deeply([splice @calls], ['build_my_customs']);
135 ok($cb->has_my_customs, "correct predicate");
136 ok($cb->clear_my_customs, "correct clearer");
137 ok(!$cb->has_my_customs, "correct predicate");
138
139 do {
140     package Class::UnderscoreBuilder;
141     use Mouse;
142
143     has _attr => (
144         is => 'ro',
145         lazy_build => 1,
146     );
147
148     sub _build__attr {
149         push @calls, '_build__attr';
150         return 'ping';
151     }
152 };
153
154 my $cub = Class::UnderscoreBuilder->new;
155 ok(!$cub->_has_attr, "correct predicate");
156 is($cub->_attr, 'ping');
157 is_deeply([splice @calls], ['_build__attr']);
158 ok($cub->_has_attr, "correct predicate");
159 ok($cub->_clear_attr, "correct clearer");
160 ok(!$cub->_has_attr, "correct predicate");
161