From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 29 May 2007 14:28:54 +0000 (+0000)
Subject: fixed RT 27329
X-Git-Tag: 0_38~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=795a0c8bdd199dc8f4d9b3efb6414a1c1354cf69;p=gitmo%2FClass-MOP.git

fixed RT 27329
---

diff --git a/Changes b/Changes
index 433ce6b..bd37525 100644
--- a/Changes
+++ b/Changes
@@ -13,6 +13,11 @@ Revision history for Perl extension Class-MOP.
         thanks to groditi for this code, tests 
         and docs.
         - added tests and POD for this
+    
+    * Class::MOP::Class
+      - fixed RT issue #27329, clone object now 
+        handles undef values correctly.
+        - added tests for this
 
 0.37 Sat. March 10, 2007
     ~~ Many, many documentation updates ~~
diff --git a/MANIFEST b/MANIFEST
index 0367ffa..0b9e0c9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -72,6 +72,7 @@ t/107_C3MethodDispatchOrder_test.t
 t/108_ArrayBasedStorage_test.t
 t/200_Class_C3_compatibility.t
 t/300_random_eval_bug.t
+t/301_RT_27329_fix.t
 t/pod.t
 t/pod_coverage.t
 t/lib/BinaryTree.pm
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 2861243..1e6e6ae 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -13,7 +13,7 @@ use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION   = '0.22';
+our $VERSION   = '0.23';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Module';
@@ -344,7 +344,7 @@ sub clone_instance {
     my $meta_instance = $class->get_meta_instance();
     my $clone = $meta_instance->clone_instance($instance);     
     foreach my $attr ($class->compute_all_applicable_attributes()) {
-        if ($params{$attr->init_arg}) {
+        if (exists $params{$attr->init_arg}) {
             $meta_instance->set_slot_value($clone, $attr->name, $params{$attr->init_arg});                    
         }
     }       
diff --git a/t/301_RT_27329_fix.t b/t/301_RT_27329_fix.t
new file mode 100644
index 0000000..ab26542
--- /dev/null
+++ b/t/301_RT_27329_fix.t
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+BEGIN {
+    use_ok('Class::MOP');
+}
+
+=pod
+
+This tests a bug sent via RT #27329
+
+=cut
+
+{
+    package Foo;
+    use metaclass;
+    
+    Foo->meta->add_attribute('foo' => (
+        init_arg => 'foo',
+        reader   => 'get_foo',
+        default  => 'BAR',
+    ));
+    
+}
+
+my $foo = Foo->meta->new_object;
+isa_ok($foo, 'Foo');
+
+is($foo->get_foo, 'BAR', '... got the right default value');
+
+{
+    my $clone = $foo->meta->clone_object($foo, foo => 'BAZ');
+    isa_ok($clone, 'Foo');
+    isnt($clone, $foo, '... and it is a clone');
+    
+    is($clone->get_foo, 'BAZ', '... got the right cloned value');
+}
+
+{
+    my $clone = $foo->meta->clone_object($foo, foo => undef);
+    isa_ok($clone, 'Foo');
+    isnt($clone, $foo, '... and it is a clone');
+        
+    ok(!defined($clone->get_foo), '... got the right cloned value');
+}
+
+
+
+
+
+