The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use lib qw(t);
use strict;
use Carp;
use Test::More;
use Test::Deep;
require 'autohash.TieMV.pm';	# example tied hash class
use autohashUtil;
use Hash::AutoHash qw(autohash_new autohash_hash autohash_tie 
			      autohash_wrap autohash_wraptie autohash_wrapobj);
use Hash::AutoHash qw(autohash_delete);

my @INITIAL_VALUES=(key0=>'value01',key1=>'value11',key2=>'value21');
my $UNDEFS=[undef,undef,undef];
my %VALUES_SV=(0=>['value01','value11','value21'],
	       1=>[undef,'value11','value21'],
	       2=>[undef,undef,'value21'],
	       3=>[undef,undef,undef]);
my %VALUES_MV=(0=>[['value01'],['value11'],['value21']],
	       1=>[undef,['value11'],['value21']],
	       2=>[undef,undef,['value21']],
	       3=>[undef,undef,undef]);

sub test_delete_func {
  my($label,$how_many,$correct,$ok_hash,$ok_object)=@_;
  $label.=' after delete via function'.($how_many==1? ' 1 keys:': " $how_many keys:");
  my $values=$correct->{$how_many} || $UNDEFS;
  my @deletes=map {"key$_"} (0..$how_many-1);
  autohash_delete($autohash,@deletes);
  cmp_autohash($label,$values,$ok_hash,$ok_object); # tests values of keys
  # also test which keys are present
  my @correct=map {"key$_"} ($how_many..2);
  cmp_set([keys %$autohash],\@correct,"$label remaining keys");
}
sub test_delete_ashash {
  my($label,$how_many,$correct,$ok_hash,$ok_object)=@_;
  $label.=' after delete as hash'.($how_many==1? ' 1 keys:': " $how_many keys:");
  my $values=$correct->{$how_many} || $UNDEFS;
  my @deletes=map {"key$_"} (0..$how_many-1);
  delete @$autohash{@deletes};
  cmp_autohash($label,$values,$ok_hash,$ok_object); # tests values of keys
  # also test which keys are present
  my @correct=map {"key$_"} ($how_many..2);
  cmp_set([keys %$autohash],\@correct,"$label remaining keys");
}
sub test_delete_exthash {
  my($label,$how_many,$correct,$ok_hash,$ok_object)=@_;
  $label.=' after delete external hash'.($how_many==1? ' 1 keys:': " $how_many keys:");
  my $values=$correct->{$how_many} || $UNDEFS;
  my @deletes=map {"key$_"} (0..$how_many-1);
  delete @hash{@deletes};
  cmp_autohash($label,$values,$ok_hash,$ok_object); # tests values of keys
  # also test which keys are present
  my @correct=map {"key$_"} ($how_many..2);
  cmp_set([keys %$autohash],\@correct,"$label remaining keys");
}
sub test_delete_extobj {
  my($label,$how_many,$correct,$ok_hash,$ok_object)=@_;
  $label.=' after delete external object'.($how_many==1? ' 1 keys:': " $how_many keys:");
  my $values=$correct->{$how_many} || $UNDEFS;
  my @deletes=map {"key$_"} (0..$how_many-1);
  map {$object->DELETE($_)} @deletes;
  cmp_autohash($label,$values,$ok_hash,$ok_object); # tests values of keys
  # also test which keys are present
  my @correct=map {"key$_"} ($how_many..2);
  cmp_set([keys %$autohash],\@correct,"$label remaining keys");
}

my $constructor='autohash_new (real)';
for(my $i=0; $i<=3; $i++) {
  for my $test(qw(func ashash)) {
    undef $autohash; undef $object; untie %hash; undef %hash;
    my $sub="test_delete_$test";
    $autohash=autohash_new @INITIAL_VALUES;
    no strict 'refs';
    &$sub($constructor,$i,\%VALUES_SV);
  }}
my $constructor='autohash_new (tie)';
for(my $i=0; $i<=3; $i++) {
  for my $test(qw(func ashash)) {
    undef $autohash; undef $object; untie %hash; undef %hash;
    my $sub="test_delete_$test";
    $autohash=autohash_new ['TieMV'],@INITIAL_VALUES;
    no strict 'refs';
    &$sub($constructor,$i,\%VALUES_MV);
  }}
my $constructor='autohash_new (wrap real)';
for(my $i=0; $i<=3; $i++) {
  for my $test(qw(func ashash exthash)) {
    undef $autohash; undef $object; untie %hash; undef %hash;
    my $sub="test_delete_$test";
    $autohash=autohash_new \%hash,@INITIAL_VALUES;
    no strict 'refs';
    &$sub($constructor,$i,\%VALUES_SV,'hash',undef);
  }}
my $constructor='autohash_new (wrap tied)';
for(my $i=0; $i<=3; $i++) {
   for my $test(qw(func ashash exthash extobj)) {
    undef $autohash; undef $object; untie %hash; undef %hash;
    my $sub="test_delete_$test";
    $object=tie %hash,'TieMV';
    $autohash=autohash_new \%hash,@INITIAL_VALUES;
    no strict 'refs';
    &$sub($constructor,$i,\%VALUES_MV,'hash','object');
  }}
my $constructor='autohash_new (wrap object)';
for(my $i=0; $i<=3; $i++) {
   for my $test(qw(func ashash exthash extobj)) {
    undef $autohash; undef $object; untie %hash; undef %hash;
    my $sub="test_delete_$test";
    $object=tie %hash,'TieMV';
    $autohash=autohash_new $object,@INITIAL_VALUES;
    no strict 'refs';
    &$sub($constructor,$i,\%VALUES_MV,'hash','object');
  }}
my $constructor='autohash_new (wraptie)';
for(my $i=0; $i<=3; $i++) {
   for my $test(qw(func ashash exthash extobj)) {
    undef $autohash; undef $object; untie %hash; undef %hash;
    my $sub="test_delete_$test";
    $autohash=autohash_new [\%hash,'TieMV'],@INITIAL_VALUES;
    $object=tied(%hash);
    no strict 'refs';
    &$sub($constructor,$i,\%VALUES_MV,'hash','object');
  }}

my $constructor='autohash_hash';
for(my $i=0; $i<=3; $i++) {
  for my $test(qw(func ashash)) {
    undef $autohash; undef $object; untie %hash; undef %hash;
    my $sub="test_delete_$test";
    $autohash=autohash_hash @INITIAL_VALUES;
    no strict 'refs';
    &$sub($constructor,$i,\%VALUES_SV);
  }}
my $constructor='autohash_tie';
for(my $i=0; $i<=3; $i++) {
  for my $test(qw(func ashash)) {
    undef $autohash; undef $object; untie %hash; undef %hash;
    my $sub="test_delete_$test";
    $autohash=autohash_tie TieMV,@INITIAL_VALUES;
    no strict 'refs';
    &$sub($constructor,$i,\%VALUES_MV);
  }}
my $constructor='autohash_wrap (real)';
for(my $i=0; $i<=3; $i++) {
  for my $test(qw(func ashash exthash)) {
    undef $autohash; undef $object; untie %hash; undef %hash;
    my $sub="test_delete_$test";
    $autohash=autohash_wrap %hash,@INITIAL_VALUES;
    no strict 'refs';
    &$sub($constructor,$i,\%VALUES_SV,'hash',undef);
  }}
my $constructor='autohash_wrap (tied)';
for(my $i=0; $i<=3; $i++) {
   for my $test(qw(func ashash exthash extobj)) {
     undef $autohash; undef $object; untie %hash; undef %hash;
     my $sub="test_delete_$test";
     $object=tie %hash,'TieMV';
     $autohash=autohash_wrap %hash,@INITIAL_VALUES;
     no strict 'refs';
     &$sub($constructor,$i,\%VALUES_MV,'hash','object');
  }}
my $constructor='autohash_wrapobj';
for(my $i=0; $i<=3; $i++) {
   for my $test(qw(func ashash exthash extobj)) {
     undef $autohash; undef $object; untie %hash; undef %hash;
     my $sub="test_delete_$test";
     $object=tie %hash,'TieMV';
     $autohash=autohash_wrapobj $object,@INITIAL_VALUES;
     no strict 'refs';
     &$sub($constructor,$i,\%VALUES_MV,'hash','object');
   }}
my $constructor='autohash_wraptie';
for(my $i=0; $i<=3; $i++) {
   for my $test(qw(func ashash exthash extobj)) {
     undef $autohash; undef $object; untie %hash; undef %hash;
     my $sub="test_delete_$test";
     $autohash=autohash_wraptie %hash,TieMV,@INITIAL_VALUES;
     $object=tied(%hash);
     no strict 'refs';
     &$sub($constructor,$i,\%VALUES_MV,'hash','object');
   }}

done_testing();