t/301_RT_27329_fix.t

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