t/301_RT_27329_fix.t

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