t/native_traits/shallow_clone.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8 use Scalar::Util qw(refaddr);
   9
  10 {
  11     package Foo;
  12     use Moose;
  13
  14     has 'array' => (
  15         traits  => ['Array'],
  16         is      => 'ro',
  17         handles => { array_clone => 'shallow_clone' },
  18     );
  19
  20     has 'hash' => (
  21         traits  => ['Hash'],
  22         is      => 'ro',
  23         handles => { hash_clone => 'shallow_clone' },
  24     );
  25
  26     no Moose;
  27 }
  28
  29 my $array = [ 1, 2, 3 ];
  30 my $hash  = { a => 1, b => 2 };
  31
  32 my $obj = Foo->new({
  33   array => $array,
  34   hash  => $hash,
  35 });
  36
  37 my $array_clone = $obj->array_clone;
  38 my $hash_clone  = $obj->hash_clone;
  39
  40 isnt(refaddr($array), refaddr($array_clone), "array clone refers to new copy");
  41 is_deeply($array_clone, $array, "...but contents are the same");
  42 isnt(refaddr($hash),  refaddr($hash_clone),  "hash clone refers to new copy");
  43 is_deeply($hash_clone, $hash, "...but contents are the same");
  44
  45 done_testing;