t/301_RT_27329_fix.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 8;
   5
   6 use Class::MOP;
   7
   8 =pod
   9
  10 This tests a bug sent via RT #27329
  11
  12 =cut
  13
  14 {
  15     package Foo;
  16     use metaclass;
  17
  18     Foo->meta->add_attribute('foo' => (
  19         init_arg => 'foo',
  20         reader   => 'get_foo',
  21         default  => 'BAR',
  22     ));
  23
  24 }
  25
  26 my $foo = Foo->meta->new_object;
  27 isa_ok($foo, 'Foo');
  28
  29 is($foo->get_foo, 'BAR', '... got the right default value');
  30
  31 {
  32     my $clone = $foo->meta->clone_object($foo, foo => 'BAZ');
  33     isa_ok($clone, 'Foo');
  34     isnt($clone, $foo, '... and it is a clone');
  35
  36     is($clone->get_foo, 'BAZ', '... got the right cloned value');
  37 }
  38
  39 {
  40     my $clone = $foo->meta->clone_object($foo, foo => undef);
  41     isa_ok($clone, 'Foo');
  42     isnt($clone, $foo, '... and it is a clone');
  43
  44     ok(!defined($clone->get_foo), '... got the right cloned value');
  45 }
  46
  47
  48
  49
  50
  51