#!/usr/bin/perl -w
use strict;
use Test::More tests=>45;
use Hash::Merge qw( merge );
my %left = ( ss => 'left',
sa => 'left',
sh => 'left',
as => [ 'l1', 'l2' ],
aa => [ 'l1', 'l2' ],
ah => [ 'l1', 'l2' ],
hs => { left=>1 },
ha => { left=>1 },
hh => { left=>1 } );
my %right = ( ss => 'right',
as => 'right',
hs => 'right',
sa => [ 'r1', 'r2' ],
aa => [ 'r1', 'r2' ],
ha => [ 'r1', 'r2' ],
sh => { right=>1 },
ah => { right=>1 },
hh => { right=>1 } );
# Test left precedence
Hash::Merge::set_behavior( 'LEFT_PRECEDENT' );
my %lp = %{merge( \%left, \%right )};
is_deeply( $lp{ss}, 'left', 'Left Precedent - Scalar on Scalar' );
is_deeply( $lp{sa}, 'left', 'Left Precedent - Scalar on Array' );
is_deeply( $lp{sh}, 'left', 'Left Precedent - Scalar on Hash' );
is_deeply( $lp{as}, [ 'l1', 'l2', 'right'], 'Left Precedent - Array on Scalar' );
is_deeply( $lp{aa}, [ 'l1', 'l2', 'r1', 'r2' ], 'Left Precedent - Array on Array' );
is_deeply( $lp{ah}, [ 'l1', 'l2', 1 ], 'Left Precedent - Array on Hash' );
is_deeply( $lp{hs}, { left=>1 }, 'Left Precedent - Hash on Scalar' );
is_deeply( $lp{ha}, { left=>1 }, 'Left Precedent - Hash on Array' );
is_deeply( $lp{hh}, { left=>1, right=>1 }, 'Left Precedent - Hash on Hash' );
Hash::Merge::set_behavior( 'RIGHT_PRECEDENT' );
my %rp = %{merge( \%left, \%right )};
is_deeply( $rp{ss}, 'right', 'Right Precedent - Scalar on Scalar' );
is_deeply( $rp{sa}, [ 'left', 'r1', 'r2' ], 'Right Precedent - Scalar on Array' );
is_deeply( $rp{sh}, { right=>1 }, 'Right Precedent - Scalar on Hash' );
is_deeply( $rp{as}, 'right', 'Right Precedent - Array on Scalar' );
is_deeply( $rp{aa}, [ 'l1', 'l2', 'r1', 'r2' ], 'Right Precedent - Array on Array' );
is_deeply( $rp{ah}, { right=>1 }, 'Right Precedent - Array on Hash' );
is_deeply( $rp{hs}, 'right', 'Right Precedent - Hash on Scalar' );
is_deeply( $rp{ha}, [ 1, 'r1', 'r2' ], 'Right Precedent - Hash on Array' );
is_deeply( $rp{hh}, { left=>1, right=>1 }, 'Right Precedent - Hash on Hash' );
Hash::Merge::set_behavior( 'STORAGE_PRECEDENT' );
my %sp = %{merge( \%left, \%right )};
is_deeply( $sp{ss}, 'left', 'Storage Precedent - Scalar on Scalar' );
is_deeply( $sp{sa}, [ 'left', 'r1', 'r2' ], 'Storage Precedent - Scalar on Array' );
is_deeply( $sp{sh}, { right=>1 }, 'Storage Precedent - Scalar on Hash' );
is_deeply( $sp{as}, [ 'l1', 'l2', 'right'], 'Storage Precedent - Array on Scalar' );
is_deeply( $sp{aa}, [ 'l1', 'l2', 'r1', 'r2' ], 'Storage Precedent - Array on Array' );
is_deeply( $sp{ah}, { right=>1 }, 'Storage Precedent - Array on Hash' );
is_deeply( $sp{hs}, { left=>1 }, 'Storage Precedent - Hash on Scalar' );
is_deeply( $sp{ha}, { left=>1 }, 'Storage Precedent - Hash on Array' );
is_deeply( $sp{hh}, { left=>1, right=>1 }, 'Storage Precedent - Hash on Hash' );
Hash::Merge::set_behavior( 'RETAINMENT_PRECEDENT' );
my %rep = %{merge( \%left, \%right )};
is_deeply( $rep{ss}, [ 'left', 'right' ], 'Retainment Precedent - Scalar on Scalar' );
is_deeply( $rep{sa}, [ 'left', 'r1', 'r2' ], 'Retainment Precedent - Scalar on Array' );
is_deeply( $rep{sh}, { left=>'left', right=>1 }, 'Retainment Precedent - Scalar on Hash' );
is_deeply( $rep{as}, [ 'l1', 'l2', 'right'], 'Retainment Precedent - Array on Scalar' );
is_deeply( $rep{aa}, [ 'l1', 'l2', 'r1', 'r2' ], 'Retainment Precedent - Array on Array' );
is_deeply( $rep{ah}, { l1=>'l1', l2=>'l2', right=>1 },
'Retainment Precedent - Array on Hash' );
is_deeply( $rep{hs}, { left=>1, right=>'right' },
'Retainment Precedent - Hash on Scalar' );
is_deeply( $rep{ha}, { left=>1, r1=>'r1', r2=>'r2' },
'Retainment Precedent - Hash on Array' );
is_deeply( $rep{hh}, { left=>1, right=>1 }, 'Retainment Precedent - Hash on Hash' );
Hash::Merge::specify_behavior( {
SCALAR => {
SCALAR => sub { $_[0] },
ARRAY => sub { $_[0] },
HASH => sub { $_[0] } },
ARRAY => {
SCALAR => sub { $_[0] },
ARRAY => sub { $_[0] },
HASH => sub { $_[0] } },
HASH => {
SCALAR => sub { $_[0] },
ARRAY => sub { $_[0] },
HASH => sub { $_[0] } }
}, "My Behavior" );
my %cp = %{merge( \%left, \%right )};
is_deeply( $cp{ss}, 'left', 'Custom Precedent - Scalar on Scalar' );
is_deeply( $cp{sa}, 'left', 'Custom Precedent - Scalar on Array' );
is_deeply( $cp{sh}, 'left', 'Custom Precedent - Scalar on Hash' );
is_deeply( $cp{as}, [ 'l1', 'l2'], 'Custom Precedent - Array on Scalar' );
is_deeply( $cp{aa}, [ 'l1', 'l2'], 'Custom Precedent - Array on Array' );
is_deeply( $cp{ah}, [ 'l1', 'l2'], 'Custom Precedent - Array on Hash' );
is_deeply( $cp{hs}, { left=>1 }, 'Custom Precedent - Hash on Scalar' );
is_deeply( $cp{ha}, { left=>1 }, 'Custom Precedent - Hash on Array' );
is_deeply( $cp{hh}, { left=>1 }, 'Custom Precedent - Hash on Hash' );