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