From: Dave Rolsky <autarch@houseabsolute.urth.org>
Date: Fri, 27 Mar 2009 21:21:36 +0000 (-0500)
Subject: make a lazy attribute use the same logic value coercion and constraint checking as... 
X-Git-Tag: 0.73_01~46
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=641e22646464b6cbc2190aa87b3f2a4c9d797e32;p=gitmo%2FMoose.git

make a lazy attribute use the same logic value coercion and constraint checking as a regular set, when inlining
---

diff --git a/Changes b/Changes
index 59a992c..c7f6c75 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,12 @@
 Revision history for Perl extension Moose
 
+0.75
+    * Moose::Meta::Method::Accessor
+      - If an attribute had a lazy default, and that value did not
+        pass the attribute's type constraint, it did not get the
+        message from the type constraint, instead using a generic
+        message. Test provided by perigrin.
+
 0.73 Fri, March 29, 2009
     * No changes from 0.72_01.
 
diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index f5f539e..21e56d0 100644
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -52,7 +52,7 @@ sub generate_accessor_method_inline {
     . 'if (scalar(@_) >= 2) {' . "\n"
         . $self->_inline_copy_value . "\n"
         . $self->_inline_check_required . "\n"
-        . $self->_inline_check_coercion . "\n"
+        . $self->_inline_check_coercion($value_name) . "\n"
         . $self->_inline_check_constraint($value_name) . "\n"
         . $self->_inline_store($inv, $value_name) . "\n"
         . $self->_inline_trigger($inv, $value_name) . "\n"
@@ -75,7 +75,7 @@ sub generate_writer_method_inline {
     . $self->_inline_pre_body(@_)
     . $self->_inline_copy_value
     . $self->_inline_check_required
-    . $self->_inline_check_coercion
+    . $self->_inline_check_coercion($value_name)
     . $self->_inline_check_constraint($value_name)
     . $self->_inline_store($inv, $value_name)
     . $self->_inline_post_body(@_)
@@ -132,10 +132,12 @@ sub _inline_check_constraint {
 }
 
 sub _inline_check_coercion {
-    my $attr = (shift)->associated_attribute;
+    my ($self, $value) = @_;
+
+    my $attr = $self->associated_attribute;
     
     return '' unless $attr->should_coerce;
-    return '$val = $attr->type_constraint->coerce($_[1]);'
+    return "$value = \$attr->type_constraint->coerce($value);";
 }
 
 sub _inline_check_required {
@@ -172,11 +174,8 @@ sub _inline_check_lazy {
                          '        ' . $self->_inline_throw_error(q{sprintf "%s does not support builder method '%s' for attribute '%s'", ref(} . $instance . ') || '.$instance.', $attr->builder, $attr->name') .
                          ';'. "\n    }";
             }
-            $code .= '    $default = $type_constraint_obj->coerce($default);'."\n"  if $attr->should_coerce;
-            $code .= '    ($type_constraint->($default))' .
-                     '            || ' . $self->_inline_throw_error('"Attribute (" . $attr_name . ") does not pass the type constraint ("' .
-                     '           . $type_constraint_name . ") with " . (defined($default) ? overload::StrVal($default) : "undef")' ) . ';' 
-                     . "\n";
+            $code .= $self->_inline_check_coercion('$default') . "\n";
+            $code .= $self->_inline_check_constraint('$default') . "\n";
             $code .= '    ' . $self->_inline_init_slot($attr, $instance, $slot_access, '$default') . "\n";
         } 
         else {