#!/usr/bin/perl -T -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = '../lib'; } } BEGIN { unless ( eval { require Storable; 1 } ){ print "1..0 # Skip -- Storable is not available\n"; exit 0; } } use strict; use Tie::RefHash; use Storable qw/dclone nfreeze thaw/; $\ = "\n"; print "1..42"; sub ok ($$) { print ( ( $_[0] ? "" : "not " ), "ok - $_[1]" ); } sub is ($$$) { print ( ( ( $_[0] eq $_[1] ) ? "" : "not "), "ok - $_[2]" ); } sub isa_ok ($$) { ok( eval { $_[0]->isa($_[1]) }, "the object isa $_[1]"); } tie my %hash, "Tie::RefHash"; my $key = { foo => 1 }; $hash{$key} = "value"; $hash{non_ref} = "other"; foreach my $clone ( \%hash, dclone(\%hash), thaw(nfreeze(\%hash)) ){ ok( tied(%$clone), "copy is tied"); isa_ok( tied(%$clone), "Tie::RefHash" ); my @keys = keys %$clone; is( scalar(@keys), 2, "two keys in clone"); my $key = ref($keys[0]) ? shift @keys : pop @keys; my $reg = $keys[0]; ok( ref($key), "key is a ref after clone" ); is( $key->{foo}, 1, "key serialized ok"); is( $clone->{$key}, "value", "and is still pointing at the same value" ); ok( !ref($reg), "regular key is non ref" ); is( $clone->{$reg}, "other", "and is also a valid key" ); } tie my %only_refs, "Tie::RefHash"; $only_refs{$key} = "value"; foreach my $clone ( \%only_refs, dclone(\%only_refs), thaw(nfreeze(\%only_refs)) ){ ok( tied(%$clone), "copy is tied"); isa_ok( tied(%$clone), "Tie::RefHash" ); my @keys = keys %$clone; is( scalar(@keys), 1, "one key in clone"); my $key = $keys[0]; ok( ref($key), "key is a ref after clone" ); is( $key->{foo}, 1, "key serialized ok"); is( $clone->{$key}, "value", "and is still pointing at the same value" ); }