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 ~~
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
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';
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});
}
}
--- /dev/null
+#!/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');
+}
+
+
+
+
+
+