Tests and implementation for builder with lazy and clearer

diff --git a/lib/Mouse/Attribute.pm b/lib/Mouse/Attribute.pm
index dd4a7ae..1a971bf 100644 (file)
--- a/lib/Mouse/Attribute.pm
+++ b/lib/Mouse/Attribute.pm
@@ -49,6 +49,7 @@ sub generate_accessor {
     my $trigger    = $attribute->trigger;
     my $type       = $attribute->type_constraint;
     my $constraint = $attribute->find_type_constraint;
+    my $builder    = $attribute->builder;
 
     my $accessor = 'sub {
         my $self = shift;';
@@ -81,9 +82,13 @@ sub generate_accessor {
 
     if ($attribute->is_lazy) {
         $accessor .= '$self->{$key} = ';
-        $accessor .= ref($default) eq 'CODE'
-                   ? '$default->($self)'
-                   : '$default';
+
+        $accessor .= $attribute->has_builder
+                   ? '$self->$builder'
+                     : ref($default) eq 'CODE'
+                     ? '$default->($self)'
+                     : '$default';
+
         $accessor .= ' if !exists($self->{$key});';
     }
 
@@ -135,7 +140,7 @@ sub create {
     my ($self, $class, $name, %args) = @_;
 
     confess "You must specify a default for lazy attribute '$name'"
-        if $args{lazy} && !exists($args{default});
+        if $args{lazy} && !exists($args{default}) && !exists($args{builder});
 
     confess "Trigger is not allowed on read-only attribute '$name'"
         if $args{trigger} && $args{is} ne 'rw';

diff --git a/t/023-builder.t b/t/023-builder.t
index 275ae59..2dff1dd 100644 (file)
--- a/t/023-builder.t
+++ b/t/023-builder.t
@@ -1,9 +1,10 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 6;
+use Test::More tests => 20;
 
 my $builder_called = 0;
+my $lazy_builder_called = 0;
 
 do {
     package Class;
@@ -15,14 +16,30 @@ do {
         builder  => '_build_name',
     );
 
-    sub default_name { "Frank" }
     sub _build_name {
         my $self = shift;
         ++$builder_called;
-        return uc $self->default_name;
+        return "FRANK";
     };
+
+    has age => (
+        is      => 'ro',
+        isa     => 'Int',
+        builder => '_build_age',
+        lazy    => 1,
+        clearer => 'clear_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");
 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");
@@ -35,4 +52,26 @@ my $object2 = Class->new;
 is($object2->name, "FRANK", "builder called to provide the default value");
 is($builder_called, 1, "builder called ONCE to provide the default value");
 
-# XXX: test clearer, lazy
+# lazy builder
+my $object3 = Class->new;
+is($lazy_builder_called, 0, "lazy builder not called yet");
+is($object3->age, 20, "lazy builder value");
+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");
+
+$object3->clear_age;
+is($lazy_builder_called, 1, "lazy builder not called on clear");
+is($object3->age, 20, "lazy builder value");
+is($lazy_builder_called, 2, "lazy builder called on get after clear");
+
+$lazy_builder_called = 0 ;
+my $object4 = Class->new(age => 50);
+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;
+is($lazy_builder_called, 0, "lazy builder not called on clear");
+is($object4->age, 20, "lazy builder value");
+is($lazy_builder_called, 1, "lazy builder called on get after clear");