Commit | Line | Data |
f0f40d86 |
1 | #!/usr/bin/perl -T -w |
2 | |
3 | BEGIN { |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6 | @INC = '../lib'; |
7 | } |
8 | } |
9 | |
10 | BEGIN { |
11 | unless ( eval { require Storable; 1 } ){ |
12 | print "1..0 # Skip -- Storable is not available\n"; |
13 | exit 0; |
14 | } |
15 | } |
16 | |
17 | use strict; |
18 | |
19 | use Tie::RefHash; |
20 | |
21 | use Storable qw/dclone nfreeze thaw/; |
22 | |
23 | $\ = "\n"; |
24 | print "1..24"; |
25 | |
26 | sub ok ($$) { |
27 | print ( ( $_[0] ? "" : "not " ), "ok - $_[1]" ); |
28 | } |
29 | |
30 | sub is ($$$) { |
31 | print ( ( ( $_[0] eq $_[1] ) ? "" : "not "), "ok - $_[2]" ); |
32 | } |
33 | |
34 | sub isa_ok ($$) { |
35 | ok( eval { $_[0]->isa($_[1]) }, "the object isa $_[1]"); |
36 | } |
37 | |
38 | tie my %hash, "Tie::RefHash"; |
39 | |
40 | my $key = { foo => 1 }; |
41 | $hash{$key} = "value"; |
42 | $hash{non_ref} = "other"; |
43 | |
44 | foreach my $clone ( \%hash, dclone(\%hash), thaw(nfreeze(\%hash)) ){ |
45 | |
46 | ok( tied(%$clone), "copy is tied"); |
47 | isa_ok( tied(%$clone), "Tie::RefHash" ); |
48 | |
49 | my @keys = keys %$clone; |
50 | is( scalar(@keys), 2, "one key in clone"); |
51 | my $key = ref($keys[0]) ? shift @keys : pop @keys; |
52 | my $reg = $keys[0]; |
53 | |
54 | ok( ref($key), "key is a ref after clone" ); |
55 | is( $key->{foo}, 1, "key serialized ok"); |
56 | |
57 | is( $clone->{$key}, "value", "and is still pointing at the same value" ); |
58 | |
59 | ok( !ref($reg), "regular key is non ref" ); |
60 | is( $clone->{$reg}, "other", "and is also a valid key" ); |
61 | } |
62 | |
63 | |