################################################################################ # # $Project: /Tie-Hash-Indexed $ # $Author: mhx $ # $Date: 2006/01/21 12:07:00 +0100 $ # $Revision: 3 $ # $Source: /t/102_storable.t $ # ################################################################################ # # Copyright (c) 2002-2003 Marcus Holland-Moritz. All rights reserved. # This program is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. # ################################################################################ use Test; BEGIN { $tests = 25; plan tests => $tests }; use Tie::Hash::Indexed; ok(1); eval { require Storable; import Storable qw( dclone freeze thaw ) }; if ($@) { for (2..$tests) { skip("skip: Storable not installed", 0, 1) } exit; } if (eval $Storable::VERSION < 1.011) { for (2..$tests) { skip("skip: Storable $Storable::VERSION is buggy", 0, 1) } exit; } @keys = reverse 'a' .. 'z'; $r = do { my %h; tie %h, 'Tie::Hash::Indexed'; my $i = 1; %h = map { $_ => $i++ } @keys; dclone(\%h); }; { my $k = join(',', @keys); my $v = join(',', 1..@keys); ok(join(',', keys %$r), $k); ok(join(',', values %$r), $v); my $frozen = freeze($r); my $thawed = thaw($frozen); ok(join(',', keys %$thawed), $k); ok(join(',', values %$thawed), $v); } $r = do { my(%h1, %h2, %h3); tie %h1, 'Tie::Hash::Indexed'; tie %h2, 'Tie::Hash::Indexed'; tie %h3, 'Tie::Hash::Indexed'; %h1 = ( foo => 1, bar => 'indexed', mhx => undef ); %h2 = ( h1 => \%h1, zzz => undef, aaa => [1 .. 3] ); %h3 = ( this => 42, hash => { h1 => \%h1, h2 => \%h2 }, is => undef, indexed => [\%h2] ); dclone(\%h3); }; { my $frozen = freeze($r); my $thawed = thaw($frozen); for my $x ( $r, $thawed ) { ok(join(',', keys %$x), 'this,hash,is,indexed'); ok(join(',', keys %{$x->{indexed}[0]}), 'h1,zzz,aaa'); ok(join(',', keys %{$x->{indexed}[0]{h1}}), 'foo,bar,mhx'); ok(not defined $x->{is}); ok(not defined $x->{hash}{h1}{mhx}); ok(not defined $x->{hash}{h2}{zzz}); ok($x->{this}, 42); ok($x->{hash}{h1}, $x->{hash}{h2}{h1}); ok($x->{hash}{h2}, $x->{indexed}[0]); ok(join(',', @{$x->{hash}{h2}{aaa}}), '1,2,3'); } }