The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
################################################################################
#
# $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');
  }
}