From: Karen Etheridge <ether@cpan.org>
Date: Sun, 25 Mar 2012 01:45:38 +0000 (-0700)
Subject: fixed: immutable class with undef-tolerant TC should not have its undef value strippe... 
X-Git-Tag: 0.13~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f6bb95bdebbbae7cf93ef9c3c5644d810c21292f;p=gitmo%2FMooseX-UndefTolerant.git

fixed: immutable class with undef-tolerant TC should not have its undef value stripped at construction time
---

diff --git a/Changes b/Changes
index 83fb3c2..671357f 100644
--- a/Changes
+++ b/Changes
@@ -7,6 +7,9 @@ Revision history for MooseX-UndefTolerant
     * undef attr values being stripped at construction time are now removed
       from visibility of all attr initializations, not just the one being
       updated at the time
+    * fixed case where an attribute on an immutable class was being stripped
+      of its undef value at construction time even if its type constraint
+      already can tolerate undef.
 
 0.12    2011-04-03
     * This module can now be used in roles with Moose 1.9900+. (Jesse Luehrs)
diff --git a/lib/MooseX/UndefTolerant/Class.pm b/lib/MooseX/UndefTolerant/Class.pm
index 13d1380..1e5e91c 100644
--- a/lib/MooseX/UndefTolerant/Class.pm
+++ b/lib/MooseX/UndefTolerant/Class.pm
@@ -18,13 +18,19 @@ around _inline_init_attr_from_constructor => sub {
     my @source = $self->$orig(@_);
 
     my $init_arg = $attr->init_arg;
-
-    return
-        "if ( exists \$params->{$init_arg} && defined \$params->{$init_arg} ) {",
-            @source,
+    my $type_constraint = $attr->type_constraint;
+    my $tc_says_clean = ($type_constraint && !$type_constraint->check(undef) ? 1 : 0);
+
+    return ($tc_says_clean ? (
+        "if ( exists \$params->{'$init_arg'} && defined \$params->{'$init_arg'} ) {",
+        ) : (),
+        @source,
+        $tc_says_clean ? (
         '} else {',
-            "delete \$params->{$init_arg};",
-        '}';
+            "delete \$params->{'$init_arg'};",
+        '}',
+        ) : (),
+    );
 };
 
 no Moose::Role;
diff --git a/t/lib/ConstructorTests.pm b/t/lib/ConstructorTests.pm
index b36fd0d..3174157 100644
--- a/t/lib/ConstructorTests.pm
+++ b/t/lib/ConstructorTests.pm
@@ -79,7 +79,8 @@ sub do_tests
 
                 is (exception { $obj = Foo->new(attr3 => undef) }, undef,
                     'assigning undef to attr3 is acceptable');
-                ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor');
+                ok($obj->has_attr3, 'attr3 still has a value');
+                is($obj->attr3, undef, '...which is undef, when assigned undef in constructor');
             },
             undef,
             'successfully tested spot-application of UT trait in '
@@ -118,9 +119,10 @@ sub do_tests
             'assigning undef to attr2 does not produce an error');
         ok(!$obj->has_attr2, 'attr2 has no value when assigned undef in constructor');
 
-        is( exception { $obj = Foo->new(attr3 => undef) }, undef,
+        is( exception { $obj = Bar->new(attr3 => undef) }, undef,
             'assigning undef to attr3 is acceptable');
-        ok($obj->has_attr3, 'attr3 retains its undef value when assigned undef in constructor');
+        ok($obj->has_attr3, 'attr3 still has a value');
+        is($obj->attr3, undef, '...which is undef, when assigned undef in constructor');
     }
 
     {