From: Stevan Little <stevan.little@iinteractive.com>
Date: Fri, 15 Feb 2008 18:00:40 +0000 (+0000)
Subject: whoops
X-Git-Tag: 0_55~306
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8abe9636abcd0945739dfeaf971eddbe1fd0cc9e;p=gitmo%2FMoose.git

whoops
---

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index b31a5c0..fa3db88 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -261,6 +261,45 @@ sub initialize_instance_slot {
 
 ## Slot management
 
+# FIXME:
+# this duplicates too much code from 
+# Class::MOP::Attribute, we need to 
+# refactor these bits eventually.
+# - SL
+sub _set_initial_slot_value {
+    my ($self, $meta_instance, $instance, $value) = @_;
+
+    my $slot_name = $self->name;
+
+    return $meta_instance->set_slot_value($instance, $slot_name, $value)
+        unless $self->has_initializer;
+
+    my ($type_constraint, $can_coerce);
+    if ($self->has_type_constraint) {
+        $type_constraint = $self->type_constraint;
+        $can_coerce      = ($self->should_coerce && $type_constraint->has_coercion);
+    }
+
+    my $callback = sub {
+        my $val = shift;
+        if ($type_constraint) {
+            $val = $type_constraint->coerce($val)
+                if $can_coerce;
+            $type_constraint->check($val)
+                || confess "Attribute (" 
+                         . $slot_name 
+                         . ") does not pass the type constraint because: " 
+                         . $type_constraint->get_message($val);            
+        }
+        $meta_instance->set_slot_value($instance, $slot_name, $val);
+    };
+    
+    my $initializer = $self->initializer;
+
+    # most things will just want to set a value, so make it first arg
+    $instance->$initializer($value, $callback, $self);
+}
+
 sub set_value {
     my ($self, $instance, $value) = @_;
 
diff --git a/t/020_attributes/019_attribute_lazy_initializer.t b/t/020_attributes/019_attribute_lazy_initializer.t
index ef6d0c8..40dbe54 100644
--- a/t/020_attributes/019_attribute_lazy_initializer.t
+++ b/t/020_attributes/019_attribute_lazy_initializer.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 21;
+use Test::More tests => 24;
 use Test::Exception;
 
 BEGIN {
@@ -71,6 +71,7 @@ BEGIN {
     
     has 'lazy_foo_builder_w_type' => (
         reader      => 'get_lazy_foo_builder_w_type',
+        isa         => 'Int',        
         builder     => 'get_foo_builder_w_type',
         initializer => sub {
             my ($self, $value, $callback, $attr) = @_;
@@ -124,6 +125,31 @@ BEGIN {
     is($bar->get_foo, 20, 'initial value set to 2x given value');          
 }
 
+{
+    package Fail::Bar;
+    use Moose;
+    
+    has 'foo' => (
+        reader => 'get_foo',
+        writer => 'set_foo',
+        isa    => 'Int',
+        initializer => sub {
+            my ($self, $value, $callback, $attr) = @_;
+            
+            ::isa_ok($attr, 'Moose::Meta::Attribute');
+            ::is($attr->name, 'foo', '... got the right name');
+            
+            $callback->("Hello $value World");
+        },
+    );  
+    
+    make_immutable;
+}
+
+dies_ok {
+    Fail::Bar->new(foo => 10)
+} '... this fails, because initializer returns a bad type';
+