X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F023-builder.t;h=6b3e35e2ab54de57657d6246308680a76e1d7976;hb=a254bf514576f3d4a5bcde5a0db4d4ced9ad566b;hp=e69de29bb2d1d6434b8b29ae775ad8c2e48c5391;hpb=c3398f5bd45f2851b7cd40ca9823bcf7d2378469;p=gitmo%2FMouse.git

diff --git a/t/023-builder.t b/t/023-builder.t
index e69de29..6b3e35e 100644
--- a/t/023-builder.t
+++ b/t/023-builder.t
@@ -0,0 +1,161 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 47;
+use Test::Exception;
+
+my $builder_called = 0;
+my $lazy_builder_called = 0;
+
+do {
+    package Class;
+    use Mouse;
+
+    has name => (
+        is        => 'rw',
+        isa       => 'Str',
+        builder   => '_build_name',
+        predicate => 'has_name',
+        clearer   => 'clear_name',
+    );
+
+    sub _build_name {
+        my $self = shift;
+        ++$builder_called;
+        return "FRANK";
+    };
+
+    has age => (
+        is         => 'ro',
+        isa        => 'Int',
+        lazy_build => 1,
+        clearer    => 'clear_age',
+        predicate  => 'has_age',
+    );
+
+    sub default_age { 20 }
+    sub _build_age {
+        my $self = shift;
+        ++$lazy_builder_called;
+        return $self->default_age;
+    };
+
+};
+
+# eager builder
+my $object = Class->new(name => "Bob");
+ok($object->has_name, "predicate: value from constructor");
+is($builder_called, 0, "builder not called in the constructor when we pass a value");
+is($object->name, "Bob", "builder doesn't matter when we just set the value in constructor");
+$object->name("Bill");
+is($object->name, "Bill", "builder doesn't matter when we just set the value in writer");
+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($builder_called, 1, "builder called ONCE to provide the default value");
+
+# lazy builder
+my $object3 = Class->new;
+is($lazy_builder_called, 0, "lazy builder not called yet");
+ok(!$object3->has_age, "predicate: no age yet");
+is($object3->age, 20, "lazy builder value");
+ok($object3->has_age, "predicate: have value after get");
+is($lazy_builder_called, 1, "lazy builder called on get");
+is($object3->age, 20, "lazy builder value");
+is($lazy_builder_called, 1, "lazy builder not called on subsequent gets");
+ok($object3->has_age, "predicate: have value after subsequent gets");
+
+$lazy_builder_called = 0;
+$object3->clear_age;
+ok(!$object3->has_age, "predicate: no value after clear");
+is($lazy_builder_called, 0, "lazy builder not called on clear");
+is($object3->age, 20, "lazy builder value");
+ok($object3->has_age, "predicate: have value after clear and get");
+is($lazy_builder_called, 1, "lazy builder called on get after clear");
+
+$lazy_builder_called = 0;
+my $object4 = Class->new(age => 50);
+ok($object4->has_age, "predicate: have value from constructor");
+is($lazy_builder_called, 0, "lazy builder not called yet");
+is($object4->age, 50, "value from constructor");
+is($lazy_builder_called, 0, "lazy builder not called if value is from constructor");
+
+$object4->clear_age;
+ok(!$object4->has_age, "predicate: no value after clear");
+is($lazy_builder_called, 0, "lazy builder not called on clear");
+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");
+