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();