From: Guillermo Roditi <groditi@gmail.com>
Date: Tue, 13 Nov 2007 16:26:36 +0000 (+0000)
Subject: one more thing missing in new (lack of) slot initialization
X-Git-Tag: 0_28~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1ed0b94f2778689bab78111b84efb26ae65c8eb2;p=gitmo%2FMoose.git

one more thing missing in new (lack of) slot initialization
---

diff --git a/Changes b/Changes
index 0c70805..d4ed4e9 100644
--- a/Changes
+++ b/Changes
@@ -4,6 +4,7 @@ Revision history for Perl extension Moose
     * Moose::Meta::Attribute
       - Added support for the new builder option (groditi)
       - Added support for lazy_build option (groditi)
+      - Changed slot initialization for predicate changes (groditi)
 
     * Moose::Meta::Method::Accessor
       - Added support for lazy_build option (groditi)
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 8a73555..9be1657 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -202,12 +202,10 @@ sub initialize_instance_slot {
     # try to fetch the init arg from the %params ...
 
     my $val;
+    my $value_is_set;
     if (exists $params->{$init_arg}) {
         $val = $params->{$init_arg};
-
-        if (!defined $val && $self->is_required) {
-            confess "Attribute (" . $self->name . ") is required and cannot be undef";
-        }
+        $value_is_set = 1;
     }
     else {
         # skip it if it's lazy
@@ -215,45 +213,47 @@ sub initialize_instance_slot {
         # and die if it's required and doesn't have a default value
         confess "Attribute (" . $self->name . ") is required"
             if $self->is_required && !$self->has_default && !$self->has_builder;
-    }
 
-    # if nothing was in the %params, we can use the
-    # attribute's default value (if it has one)
-    if (!defined $val && $self->has_default) {
-        $val = $self->default($instance);
-    } elsif (!defined $val && $self->has_builder) {
-        my $builder = $self->builder;
-        if($builder = $instance->can($builder)){
-            $val = $instance->$builder;
-        } else {
-            confess(blessed($instance)." does not support builder method '$builder' for attribute '" . $self->name . "'");
+        # if nothing was in the %params, we can use the
+        # attribute's default value (if it has one)
+        if ($self->has_default) {
+            $val = $self->default($instance);
+            $value_is_set = 1;
+        } elsif ($self->has_builder) {
+            my $builder = $self->builder;
+            if($builder = $instance->can($builder)){
+                $val = $instance->$builder;
+                $value_is_set = 1;
+            } else {
+                confess(blessed($instance)." does not support builder method '$builder' for attribute '" . $self->name . "'");
+            }
         }
     }
 
-        if (defined $val || $self->has_default) {
-            if ($self->has_type_constraint) {
-                my $type_constraint = $self->type_constraint;
-                    if ($self->should_coerce && $type_constraint->has_coercion) {
-                        $val = $type_constraint->coerce($val);
-                    }
-            (defined($type_constraint->check($val)))
-                || confess "Attribute (" .
-                           $self->name .
-                           ") does not pass the type constraint (" .
-                           $type_constraint->name .
-                           ") with '" .
-                           (defined $val
-                               ? (blessed($val) && overload::Overloaded($val)
-                                    ? overload::StrVal($val)
-                                    : $val)
-                               : 'undef') .
-                           "'";
-        }
+    return unless $value_is_set;
+
+    if ($self->has_type_constraint) {
+        my $type_constraint = $self->type_constraint;
+        if ($self->should_coerce && $type_constraint->has_coercion) {
+            $val = $type_constraint->coerce($val);
         }
+        (defined($type_constraint->check($val)))
+            || confess "Attribute (" .
+                       $self->name .
+                       ") does not pass the type constraint (" .
+                       $type_constraint->name .
+                       ") with '" .
+                       (defined $val
+                           ? (blessed($val) && overload::Overloaded($val)
+                                ? overload::StrVal($val)
+                                : $val)
+                           : 'undef') .
+                       "'";
+    }
 
     $meta_instance->set_slot_value($instance, $self->name, $val);
     $meta_instance->weaken_slot_value($instance, $self->name)
-        if ref $val && $self->is_weak_ref;
+      if ref $val && $self->is_weak_ref;
 }
 
 ## Slot management
diff --git a/t/020_attributes/006_attribute_required.t b/t/020_attributes/006_attribute_required.t
index 8f098b2..4f65021 100644
--- a/t/020_attributes/006_attribute_required.t
+++ b/t/020_attributes/006_attribute_required.t
@@ -7,52 +7,62 @@ use Test::More tests => 16;
 use Test::Exception;
 
 BEGIN {
-    use_ok('Moose');           
+    use_ok('Moose');
 }
 
 {
     package Foo;
     use Moose;
-    
+
     has 'bar' => (is => 'ro', required => 1);
-    has 'baz' => (is => 'rw', default => 100, required => 1); 
-    has 'boo' => (is => 'rw', lazy => 1, default => 50, required => 1);       
+    has 'baz' => (is => 'rw',  default => 100, required => 1);
+    has 'boo' => (is => 'rw', lazy => 1, default => 50, required => 1);
 }
 
 {
     my $foo = Foo->new(bar => 10, baz => 20, boo => 100);
     isa_ok($foo, 'Foo');
-    
+
     is($foo->bar, 10, '... got the right bar');
-    is($foo->baz, 20, '... got the right baz');    
-    is($foo->boo, 100, '... got the right boo');        
+    is($foo->baz, 20, '... got the right baz');
+    is($foo->boo, 100, '... got the right boo');
 }
 
 {
     my $foo = Foo->new(bar => 10, boo => 5);
     isa_ok($foo, 'Foo');
-    
+
     is($foo->bar, 10, '... got the right bar');
-    is($foo->baz, 100, '... got the right baz');    
-    is($foo->boo, 5, '... got the right boo');            
+    is($foo->baz, 100, '... got the right baz');
+    is($foo->boo, 5, '... got the right boo');
 }
 
 {
     my $foo = Foo->new(bar => 10);
     isa_ok($foo, 'Foo');
-    
+
     is($foo->bar, 10, '... got the right bar');
-    is($foo->baz, 100, '... got the right baz');    
-    is($foo->boo, 50, '... got the right boo');            
+    is($foo->baz, 100, '... got the right baz');
+    is($foo->boo, 50, '... got the right boo');
 }
 
-throws_ok {
+#Yeah.. this doesn't work like this anymore, see below. (groditi)
+#throws_ok {
+#    Foo->new(bar => 10, baz => undef);
+#} qr/^Attribute \(baz\) is required and cannot be undef/, '... must supply all the required attribute';
+
+#throws_ok {
+#    Foo->new(bar => 10, boo => undef);
+#} qr/^Attribute \(boo\) is required and cannot be undef/, '... must supply all the required attribute';
+
+lives_ok {
     Foo->new(bar => 10, baz => undef);
-} qr/^Attribute \(baz\) is required and cannot be undef/, '... must supply all the required attribute';
+} '... undef is a valid attribute value';
 
-throws_ok {
+lives_ok {
     Foo->new(bar => 10, boo => undef);
-} qr/^Attribute \(boo\) is required and cannot be undef/, '... must supply all the required attribute';
+}  '... undef is a valid attribute value';
+
 
 throws_ok {
     Foo->new;