#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 30;
+use Test::More tests => 47;
+use Test::Exception;
my $builder_called = 0;
my $lazy_builder_called = 0;
isa => 'Str',
builder => '_build_name',
predicate => 'has_name',
+ clearer => 'clear_name',
);
sub _build_name {
};
has age => (
- is => 'ro',
- isa => 'Int',
- builder => '_build_age',
- lazy => 1,
- clearer => 'clear_age',
- predicate => 'has_age',
+ is => 'ro',
+ isa => 'Int',
+ lazy_build => 1,
+ clearer => 'clear_age',
+ predicate => 'has_age',
);
sub default_age { 20 }
is($builder_called, 0, "builder not called in the setter");
$builder_called = 0;
+$object->clear_name;
+ok(!$object->has_name, "predicate: no value after clear");
+is($object->name, undef, "eager builder does NOT swoop in after clear");
+ok(!$object->has_name, "predicate: no value after clear and get");
+is($builder_called, 0, "builder not called in the getter, even after clear");
+$builder_called = 0;
+
my $object2 = Class->new;
ok($object2->has_name, "predicate: value from eager builder");
is($object2->name, "FRANK", "builder called to provide the default value");
is($object4->age, 20, "lazy builder value");
ok($object4->has_age, "predicate: have value after clear and get");
is($lazy_builder_called, 1, "lazy builder called on get after clear");
+
+do {
+ package Class::Error;
+ use Mouse;
+
+ ::throws_ok {
+ has error => (
+ lazy_build => 1,
+ default => 1,
+ );
+ } qr/You can not use lazy_build and default for the same attribute \(error\)/;
+};
+
+my @calls;
+do {
+ package Class::CustomBuilder;
+ use Mouse;
+
+ has custom => (
+ is => 'ro',
+ lazy_build => 1,
+ builder => 'build_my_customs',
+ predicate => 'has_my_customs',
+ clearer => 'clear_my_customs',
+ );
+
+ sub build_my_customs {
+ push @calls, 'build_my_customs';
+ return 'yo';
+ }
+};
+
+my $cb = Class::CustomBuilder->new;
+ok(!$cb->has_my_customs, "correct predicate");
+is($cb->custom, 'yo');
+is_deeply([splice @calls], ['build_my_customs']);
+ok($cb->has_my_customs, "correct predicate");
+ok($cb->clear_my_customs, "correct clearer");
+ok(!$cb->has_my_customs, "correct predicate");
+
+do {
+ package Class::UnderscoreBuilder;
+ use Mouse;
+
+ has _attr => (
+ is => 'ro',
+ lazy_build => 1,
+ );
+
+ sub _build__attr {
+ push @calls, '_build__attr';
+ return 'ping';
+ }
+};
+
+my $cub = Class::UnderscoreBuilder->new;
+ok(!$cub->_has_attr, "correct predicate");
+is($cub->_attr, 'ping');
+is_deeply([splice @calls], ['_build__attr']);
+ok($cub->_has_attr, "correct predicate");
+ok($cub->_clear_attr, "correct clearer");
+ok(!$cub->_has_attr, "correct predicate");
+