From: Dave Rolsky <autarch@urth.org>
Date: Fri, 29 Oct 2010 15:02:33 +0000 (-0500)
Subject: Make sure that lazy defaults are coerced and type checked
X-Git-Tag: 1.18~14
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7a431e9c3e8c7ccf455d775c939ea85bd7d7dc30;p=gitmo%2FMoose.git

Make sure that lazy defaults are coerced and type checked
---

diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index 8e1e880..837eb1d 100644
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -206,7 +206,7 @@ sub _inline_check_lazy {
                          ';'. "\n    }";
             }
             $code .= $self->_inline_check_coercion('$default') . "\n";
-            $code .= $self->_inline_check_constraint('$default') . "\n";
+            $code .= $self->_inline_check_constraint('$default', 'lazy') . "\n";
             $code .= '    ' . $self->_inline_init_slot($attr, $instance, '$default') . "\n";
         }
         else {
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Writer.pm b/lib/Moose/Meta/Method/Accessor/Native/Writer.pm
index 1c62f9b..5d76490 100644
--- a/lib/Moose/Meta/Method/Accessor/Native/Writer.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Writer.pm
@@ -137,7 +137,8 @@ sub _inline_check_coercion {
     my $attr = $self->associated_attribute;
 
     return q{}
-        unless $attr->should_coerce && $attr->type_constraint->has_coercion;
+        unless $attr->should_coerce
+            && $attr->type_constraint->has_coercion;
 
     # We want to break the aliasing in @_ in case the coercion tries to make a
     # destructive change to an array member.
@@ -145,9 +146,9 @@ sub _inline_check_coercion {
 }
 
 override _inline_check_constraint => sub {
-    my $self = shift;
+    my ( $self, $value, $for_lazy ) = @_;
 
-    return q{} unless $self->_constraint_must_be_checked;
+    return q{} unless $for_lazy || $self->_constraint_must_be_checked;
 
     return super();
 };
diff --git a/t/070_native_traits/011_array_subtypes.t b/t/070_native_traits/011_array_subtypes.t
index d78ac87..832c46c 100644
--- a/t/070_native_traits/011_array_subtypes.t
+++ b/t/070_native_traits/011_array_subtypes.t
@@ -59,6 +59,20 @@ use Test::Fatal;
             push_a3 => 'push',
         },
     );
+
+    has a4 => (
+        traits  => ['Array'],
+        is      => 'rw',
+        isa     => 'ArrayRef',
+        lazy    => 1,
+        default => 'invalid',
+        clearer => '_clear_a4',
+        handles => {
+            get_a4     => 'get',
+            push_a4     => 'push',
+            accessor_a4 => 'accessor',
+        },
+    );
 }
 
 my $foo = Foo->new;
@@ -133,4 +147,32 @@ my $foo = Foo->new;
     is_deeply( $foo->a3, [ 1, 3 ], "a3 - correct contents" );
 }
 
+{
+    my $expect = qr/\QAttribute (a4) does not pass the type constraint because: Validation failed for 'ArrayRef' with value invalid/;
+
+    like(
+        exception { $foo->accessor_a4(0); },
+        $expect,
+        'invalid default is caught when trying to read via accessor'
+    );
+
+    like(
+        exception { $foo->accessor_a4(0 => 42); },
+        $expect,
+        'invalid default is caught when trying to write via accessor'
+    );
+
+    like(
+        exception { $foo->push_a4(42); },
+        $expect,
+        'invalid default is caught when trying to push'
+    );
+
+    like(
+        exception { $foo->get_a4(42); },
+        $expect,
+        'invalid default is caught when trying to get'
+    );
+}
+
 done_testing;