use
5.012;
my
$ret
;
my
$h1d
= {
a
=> 1,
b
=> 2,
c
=> 3,
d
=> 4};
my
$h1s
= {
c
=>
'c'
,
d
=>
'd'
,
e
=>
'e'
,
f
=>
'f'
};
$ret
= hash_merge(
$h1d
,
$h1s
);
cmp_deeply(
$h1d
, merge_hash(merge_hash({},
$h1d
),
$h1s
));
is(
$ret
,
$h1d
);
my
$h2d
= {
a
=> 1,
b
=> 2,
c
=> {
aa
=> 1,
bb
=> 2}};
my
$h2s
= {
a
=> 10,
d
=> 123,
c
=> {
cc
=> 3}};
hash_merge(
$h2d
,
$h2s
);
cmp_deeply(
$h2d
, merge_hash(merge_hash({},
$h2d
),
$h2s
));
sub
merge_hash {
my
(
$hash1
,
$hash2
) = (
shift
,
shift
);
while
(
my
(
$k
,
$v2
) =
each
%$hash2
) {
my
$v1
=
$hash1
->{
$k
};
if
(
ref
(
$v1
) eq
'HASH'
&&
ref
(
$v2
) eq
'HASH'
) { merge_hash(
$v1
,
$v2
) }
else
{
$hash1
->{
$k
} =
$v2
}
}
return
$hash1
;
}
my
$aa
= {
x
=> [1,2,3],
y
=> 10};
my
$bb
= {
x
=> [3,4,5],
y
=> 20,
z
=> 5,
k
=>
'abcd'
};
hash_merge(
$aa
,
$bb
, ARRAY_CONCAT);
cmp_deeply(
$aa
, {
x
=> [1,2,3,3,4,5],
y
=> 20,
z
=> 5,
k
=>
'abcd'
});
chop
(
$bb
->{k});
ok(
$bb
->{k} eq
'abc'
and
$aa
->{k} eq
'abc'
);
$bb
->{x}[0]++;
ok(
$bb
->{x}[0] == 4 and
$aa
->{x}[3] == 4);
$aa
= {
x
=> [1,2,{
a
=> 1}],
y
=> 10};
$bb
= {
x
=> [3,4,{
b
=> 2}],
y
=> 20,
z
=> 5,
k
=>
'abcd'
};
hash_merge(
$aa
,
$bb
, ARRAY_MERGE);
cmp_deeply(
$aa
, {
x
=> [3,4,{
a
=> 1,
b
=> 2}],
y
=> 20,
z
=> 5,
k
=>
'abcd'
});
$aa
= {
x
=> [1,2,{
a
=> 1}],
y
=> 10};
$bb
= {
x
=> [3,4,{
b
=> 2}],
y
=> 20,
z
=> 5,
k
=>
'abcd'
};
hash_merge(
$aa
,
$bb
, ARRAY_MERGE|LAZY);
cmp_deeply(
$aa
, {
x
=> [1,2,{
a
=> 1,
b
=> 2}],
y
=> 10,
z
=> 5,
k
=>
'abcd'
});
$aa
= {
x
=> [1,2,{
a
=> 1}],
y
=> 10};
$bb
= {
x
=> [3,4,{
b
=> 2}],
y
=> 20,
z
=> [1,2,3],
k
=> {
a
=> 1,
b
=> 2}};
$ret
= hash_merge(
$aa
,
$bb
, ARRAY_MERGE|LAZY|COPY_ALL);
cmp_deeply(
$ret
, {
x
=> [1,2,{
a
=> 1,
b
=> 2}],
y
=> 10,
z
=> [1,2,3],
k
=> {
a
=> 1,
b
=> 2}});
cmp_deeply(
$aa
, {
x
=> [1,2,{
a
=> 1}],
y
=> 10});
cmp_deeply(
$bb
, {
x
=> [3,4,{
b
=> 2}],
y
=> 20,
z
=> [1,2,3],
k
=> {
a
=> 1,
b
=> 2}});
delete
$ret
->{k}{a};
shift
@{
$ret
->{z}};
shift
@{
$ret
->{x}};
cmp_deeply(
$ret
, {
x
=> [2,{
a
=> 1,
b
=> 2}],
y
=> 10,
z
=> [2,3],
k
=> {
b
=> 2}});
cmp_deeply(
$aa
, {
x
=> [1,2,{
a
=> 1}],
y
=> 10});
cmp_deeply(
$bb
, {
x
=> [3,4,{
b
=> 2}],
y
=> 20,
z
=> [1,2,3],
k
=> {
a
=> 1,
b
=> 2}});
$aa
= {
a
=> 1,
b
=> 2,
c
=> [1,2]};
$bb
= {
a
=> 2,
b
=>
undef
,
c
=> [3,
undef
]};
hash_merge(
$aa
,
$bb
, ARRAY_MERGE);
cmp_deeply(
$aa
, {
a
=> 2,
b
=>
undef
,
c
=> [3,
undef
]});
$aa
= {
a
=> 1,
b
=> 2,
c
=> [1,2]};
$bb
= {
a
=> 2,
b
=>
undef
,
c
=> [3,
undef
]};
hash_merge(
$aa
,
$bb
, ARRAY_MERGE|SKIP_UNDEF);
cmp_deeply(
$aa
, {
a
=> 2,
b
=> 2,
c
=> [3,2]});
$aa
= {
a
=> 1,
b
=> 2,
c
=> [1,2]};
$bb
= {
a
=> 2,
b
=>
undef
,
c
=>
undef
};
hash_merge(
$aa
,
$bb
);
cmp_deeply(
$aa
, {
a
=> 2,
b
=>
undef
,
c
=>
undef
});
$aa
= {
a
=> 1,
b
=> 2,
c
=> [1,2]};
$bb
= {
a
=> 2,
b
=>
undef
,
c
=>
undef
};
hash_merge(
$aa
,
$bb
, DELETE_UNDEF);
cmp_deeply(
$aa
, {
a
=> 2});
$aa
= {
x
=> 1,
y
=> 3};
$bb
= {
x
=> 2,
s
=>
'str'
};
$ret
= hash_merge(
$aa
,
$bb
, COPY_DEST);
cmp_deeply(
$aa
, {
x
=> 1,
y
=> 3});
cmp_deeply(
$bb
, {
x
=> 2,
s
=>
'str'
});
cmp_deeply(
$ret
, {
x
=> 2,
y
=> 3,
s
=>
'str'
});
chop
(
$ret
->{s});
is(
$bb
->{s},
'st'
);
$aa
= {
x
=> 1,
y
=> 3};
$bb
= {
x
=> 2,
s
=>
'str'
,
d
=> [1,2]};
$ret
= hash_merge(
$aa
,
$bb
, COPY_SOURCE);
cmp_deeply(
$aa
, {
x
=> 2,
y
=> 3,
s
=>
'str'
,
d
=> [1,2]});
cmp_deeply(
$bb
, {
x
=> 2,
s
=>
'str'
,
d
=> [1,2]});
cmp_deeply(
$ret
, {
x
=> 2,
y
=> 3,
s
=>
'str'
,
d
=> [1,2]});
is(
$ret
,
$aa
);
chop
(
$ret
->{s});
shift
@{
$ret
->{d}};
is(
$bb
->{s},
'str'
);
is(
$ret
->{d}[0], 2);
is(
$bb
->{d}[0], 1);
$aa
= {
x
=> 1,
y
=> 3};
$ret
= hash_merge(
$aa
,
undef
);
is(
$ret
,
$aa
);
cmp_deeply(
$aa
, {
x
=> 1,
y
=> 3});
$ret
= hash_merge(
$aa
,
undef
, COPY_DEST);
ok(
$ret
ne
$aa
);
delete
$aa
->{x};
cmp_deeply(
$aa
, {
y
=> 3});
cmp_deeply(
$ret
, {
x
=> 1,
y
=> 3});
$ret
= hash_merge({},{});
cmp_deeply(
$ret
, {});
$bb
= {
x
=> 1,
y
=> 3};
$ret
= hash_merge(
undef
,
$bb
);
ok(
$ret
ne
$bb
);
cmp_deeply(
$ret
,
$bb
);
$ret
= hash_merge(
undef
,
undef
);
cmp_deeply(
$ret
, {});
subtest
'cycle-ref-merge'
=>
sub
{
subtest
'same'
=>
sub
{
my
$d
= {};
$d
->{bar} =
$d
;
hash_merge(
$d
,
$d
);
hash_merge(
$d
,
$d
->{bar});
is
scalar
(
keys
%$d
), 1;
is
$d
->{bar},
$d
;
};
subtest
'symmetric different'
=>
sub
{
my
$d
= {};
$d
->{bar} =
$d
;
my
$s
= {};
$s
->{bar} =
$s
;
throws_ok { hash_merge(
$d
,
$s
) }
qr/synchronous cycled reference/
;
};
};
done_testing();