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 Scalar::Util qw(refaddr weaken);
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);

#################################################################################
package Child;
our $VERSION='1.00_1111';

use strict;
use Hash::AutoHash;
our @ISA=qw(Hash::AutoHash);

package Child::helper;
use strict;
our @ISA=qw(Hash::AutoHash::helper);
use Hash::AutoHash qw(autohash_tie);

sub _new {
  my($helper_class,$class,@args)=@_;
  my $self=autohash_tie TieMV,@args;
  bless $self,$class;
}

package main;
our $DESTROYED=\%TieMV::DESTROYED;
my @INITIAL_VALUES=(key0=>'value01',key1=>'value11',key2=>'value21');
my %INITIAL_VALUES=@INITIAL_VALUES;
my @KEYS=keys %INITIAL_VALUES;
my($autohash_sav,$hash,$object);

sub test_destroy {
  my($label,$ok_hash,$ok_object)=@_;
  my(@ok,@fail);
  eq_set([keys %$autohash],\@KEYS)? push(@ok,'autohash'): push(@fail,'autohash');
  if ($ok_hash) {
    eq_set([keys %$hash],\@KEYS)? push(@ok,'hash'): push(@fail,'hash');
  } else {
    ($hash eq undef)? push(@ok,'hash'): push(@fail,'hash');
  }
  if ($ok_object) {
    eq_set([keys_obj($object)],\@KEYS)? push(@ok,'object'): push(@fail,'object');
  } else {
    ($object eq undef)? push(@ok,'object'): push(@fail,'object');
  }
  my $tiedaddr=ref(tied %$autohash) eq 'TieMV'? refaddr(tied %$autohash): undef;
  if ($tiedaddr) {
    ($DESTROYED->{$tiedaddr} eq 0)? 
      push(@ok,'TieMV::DESTROYED'): push(@fail,'TieMV::DESTROYED');
  }
  report("$label before destroy",@ok,@fail);

  # weaken refs used in test, then undef $autohash, and everything should be destroyed
  $autohash_sav=$autohash;
  weaken($autohash_sav); weaken($hash); weaken($object);
  undef $autohash;

  my(@ok,@fail);
  ($autohash_sav eq undef)? push(@ok,'autohash'): push(@fail,'autohash');
  ($hash eq undef)? push(@ok,'hash'): push(@fail,'hash');
  ($object eq undef)? push(@ok,'object'): push(@fail,'object');
  if ($tiedaddr) {
    ($DESTROYED->{$tiedaddr} eq 1)? 
      push(@ok,'TieMV::DESTROYED'): push(@fail,'TieMV::DESTROYED');
  }
  report("$label after destroy",@ok,@fail);
}

################################################################################
# tests start here
################################################################################

my $constructor='autohash_new (real)';
undef $autohash; undef $object; untie $hash; undef $hash;
$autohash=autohash_new @INITIAL_VALUES;
test_destroy($constructor);

my $constructor='autohash_new (tie)';
undef $autohash; undef $object; untie $hash; undef $hash;
$autohash=autohash_new ['TieMV'],@INITIAL_VALUES;
test_destroy($constructor);

my $constructor='autohash_new (wrap real)';
undef $autohash; undef $object; untie $hash; undef $hash;
$hash={};
$autohash=autohash_new $hash,@INITIAL_VALUES;
test_destroy($constructor,'hash');

my $constructor='autohash_new (wrap tied)';
undef $autohash; undef $object; untie $hash; undef $hash;
$hash={};
$object=tie %$hash,'TieMV';
$autohash=autohash_new $hash,@INITIAL_VALUES;
test_destroy($constructor,'hash','object');

my $constructor='autohash_new (wrap object)';
undef $autohash; undef $object; untie $hash; undef $hash;  
$hash={};
$object=tie %$hash,'TieMV';
$autohash=autohash_new $object,@INITIAL_VALUES;
test_destroy($constructor,'hash','object');

my $constructor='autohash_new (wraptie)';
undef $autohash; undef $object; untie $hash; undef $hash;
$hash={};
$autohash=autohash_new [$hash,'TieMV'],@INITIAL_VALUES;
$object=tied(%$hash);
test_destroy($constructor,'hash','object');

my $constructor='autohash_hash';
undef $autohash; undef $object; untie $hash; undef $hash;
$autohash=autohash_hash @INITIAL_VALUES;
test_destroy($constructor);

my $constructor='autohash_tie';
undef $autohash; undef $object; untie $hash; undef $hash;
$autohash=autohash_tie TieMV,@INITIAL_VALUES;
test_destroy($constructor);

my $constructor='autohash_wrap (real)';
undef $autohash; undef $object; untie $hash; undef $hash;
$hash={};
$autohash=autohash_wrap %$hash,@INITIAL_VALUES;
test_destroy($constructor,'hash',undef);

my $constructor='autohash_wrap (tied)';
undef $autohash; undef $object; untie $hash; undef $hash;
$hash={};
$object=tie %$hash,'TieMV';
$autohash=autohash_wrap %$hash,@INITIAL_VALUES;
test_destroy($constructor,'hash','object');

my $constructor='autohash_wrapobj';
undef $autohash; undef $object; untie $hash; undef $hash;
$hash={};
$object=tie %$hash,'TieMV';
$autohash=autohash_wrapobj $object,@INITIAL_VALUES;
test_destroy($constructor,'hash','object');

my $constructor='autohash_wraptie';
undef $autohash; undef $object; untie $hash; undef $hash;
$hash={};
$autohash=autohash_wraptie %$hash,TieMV,@INITIAL_VALUES;
$object=tied(%$hash);
test_destroy($constructor,'hash','object');

my $constructor='new Child';
undef $autohash; undef $object; untie $hash; undef $hash;
$autohash=new Child @INITIAL_VALUES;
test_destroy($constructor);

done_testing();