From: Shawn M Moore Date: Tue, 10 Jun 2008 02:42:06 +0000 (+0000) Subject: Tests and implementation for builder with lazy and clearer X-Git-Tag: 0.04~68 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=9367e029d69af6065f843df198c0631a91834c95 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 --- 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 --- 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");