From: Tomas Doran <bobtfish@bobtfish.net>
Date: Wed, 20 Aug 2008 14:02:18 +0000 (+0000)
Subject: Fix type coersion of lazy values accessed using the get_value method. I've RFC'd... 
X-Git-Tag: 0_55_01~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f92cd3009abf51fadf4bf789c089b7dd430ca59a;p=gitmo%2FMoose.git

Fix type coersion of lazy values accessed using the get_value method. I've RFC'd this patch 3-4 times on IRC, but got no feedback. Therefore I'm committing it as it passes all the pre-existing tests, and fixes the bug I found.
---

diff --git a/Changes b/Changes
index fc59bac..041a1e6 100644
--- a/Changes
+++ b/Changes
@@ -5,6 +5,10 @@ Revision history for Perl extension Moose
       - Fix inlined constructor so that values produced by default
         or builder methods are coerced as required + test (t0m)
 
+    * Moose::Meta::Attribute
+      - Fix lazy built attributes so that type coersion always
+        occurs on them when accessed with get_value method + test (t0m)
+
     * Moose::Exporter
       - This is a new helper module for writing "Moose-alike"
         modules. This should make the lives of MooseX module authors
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 2334770..69e6006 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -8,7 +8,7 @@ use Scalar::Util 'blessed', 'weaken';
 use Carp         'confess';
 use overload     ();
 
-our $VERSION   = '0.56';
+our $VERSION   = '0.57';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
@@ -489,12 +489,12 @@ sub get_value {
 
     if ($self->is_lazy) {
         unless ($self->has_value($instance)) {
+            my $value;
             if ($self->has_default) {
-                my $default = $self->default($instance);
-                $self->set_initial_value($instance, $default);
+                $value = $self->default($instance);
             } elsif ( $self->has_builder ) {
                 if (my $builder = $instance->can($self->builder)){
-                    $self->set_initial_value($instance, $instance->$builder);
+                    $value = $instance->$builder;
                 }
                 else {
                     confess(blessed($instance) 
@@ -505,9 +505,16 @@ sub get_value {
                           . "'");
                 }
             } 
-            else {
-                $self->set_initial_value($instance, undef);
+            if ($self->has_type_constraint) {
+                my $type_constraint = $self->type_constraint;
+                $value = $type_constraint->coerce($value)
+                    if ($self->should_coerce);
+                $type_constraint->check($value) 
+                  || confess "Attribute (" . $self->name
+                      . "') does not pass the type constraint because: "
+                      . $type_constraint->get_message($value);
             }
+            $self->set_initial_value($instance, $value);
         }
     }
 
diff --git a/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t b/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t
new file mode 100644
index 0000000..5f11fb6
--- /dev/null
+++ b/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t
@@ -0,0 +1,23 @@
+{
+    package SomeClass;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    subtype 'DigitSix' => as 'Num'
+        => where { /^6$/ };
+    subtype 'TextSix' => as 'Str'
+        => where { /Six/i };
+    coerce 'TextSix' 
+        => from 'DigitSix' 
+        => via { confess("Cannot live without 6 ($_)") unless /^6$/; 'Six' };
+
+    has foo => ( isa => 'TextSix', coerce => 1, is => 'ro', default => 6,
+        lazy => 1
+    ); 
+}
+
+use Test::More tests => 2;
+my $attr = SomeClass->meta->get_attribute('foo');
+is($attr->get_value(SomeClass->new()), 'Six');
+is(SomeClass->new()->foo, 'Six');
+