use strict;
use lib qw(t);
use Test::More;
use Test::Deep;
use Storable qw(dclone);
use Hash::AutoHash::Args;
use autoclassUtil;
use autoclass_010::Parent;

# test basics: create objects, get and set attributes, try each method

# cmp_object tests state of object: defined attrs and their values
# $actual is object. $correct is HASH of atttr=>value pairs wih Test::Deep decorations
sub cmp_object {
  my($actual,$correct,$label,$quiet)=@_;
  my($package,$file,$line)=caller; # for fails
  my $ok=1;
  $ok&&=cmp_can($actual,$correct,$label,$file,$line);
  $ok&&=cmp_attrs($actual,$correct,$label,$file,$line);
  report_pass($ok,$label) unless $quiet;
  $ok;
}
# cmp_values tests values extracted ('gotten') from object
# $actual, $correct are HASHes of atttr=>value pairs
sub cmp_values {
  my($actual,$correct,$label)=@_;
  my($package,$file,$line)=caller; # for fails
  my $ok=1;
  $ok&&=cmp_hashes($actual,$correct,$label,$file,$line);
  report_pass($ok,$label);
}
my @attrs=qw(auto real auto_dflt real_dflt 
	     other other_dflt 
	     class class_dflt 
	     syn syn_dflt);
my %defaults=(auto_dflt=>'auto attribute default',
	      other_dflt=>['other attribute default'],
	      class_dflt=>'class attribute default',
	      syn_dflt=>'synonym default',
	      real_dflt=>'real default',);
my @class_attrs=qw(class class_dflt);
my %class_defaults=(class_dflt => 'class attribute default');

sub correct (\@\%%) {
  my($attrs,$defaults)=splice(@_,0,2);
  my %defined_attrs=@_;
  # copy $defaults so values not clobbered...
  $defaults=dclone($defaults);
  my $correct={(map {$_=>undef} @$attrs),%$defaults};
  # 'other' attributes are special: setter pushes new value onto old
  while(my($attr,$value)=each %defined_attrs) {
    if ($attr=~/^other/ && 'ARRAY' ne ref $value) {
      push (@{$correct->{$attr}},$value);
    } else {
      $correct->{$attr}=$value;
    }
  }
  while(my($attr,$value)=each %$correct) {
    # 'syn' and 'real' attributes are special
    # if both set, either value ok. if one set, other must match
    if ($attr=~/^real/) {
      my($suffix)=$attr=~/^real(.*)$/;
      my $syn_value=$correct->{"syn$suffix"};
      if (defined $value && defined $syn_value) { # both can have either value
	$correct->{$attr}=$correct->{"syn$suffix"}=any($value,$syn_value);
      } elsif (defined $value || defined $syn_value) { # both must match
	($value)=grep {defined $_} ($value,$syn_value);
	$correct->{$attr}=$correct->{"syn$suffix"}=$value;
      }}}
  $correct;
}

my $object=new autoclass_010::Parent;
isa_ok($object,'autoclass_010::Parent','new');

# defaults
cmp_object($object,correct(@attrs,%defaults),'defaults');

# get & set each attribute one-by-one
# first get initial values
my(@ok,@bad);
my $correct=correct(@attrs,%defaults);
for my $attr (@attrs) {
  my $before=$object->$attr;
  eq_deeply($before,$correct->{$attr})? push(@ok,$attr): push(@bad,$attr);
}
report(!@bad,'get initial values one-by-one',__FILE__,__LINE__,"attributes '@bad' wrong");
# now set each attribute
my(@ok,@bad);
my $correct;
for my $attr (@attrs) {
  my $value="$attr set value";
  my $after=$object->$attr($value);
  if ($attr=~/^other/) {
    $value=[$value];
    my $default=$defaults{$attr};
    unshift(@$value,@$default) if defined $default;
  }
  $correct->{$attr}=$value;
  eq_deeply($after,$correct->{$attr})? push(@ok,$attr): push(@bad,$attr);
}
report(!@bad,'set values one-by-one',__FILE__,__LINE__,"attributes '@bad' wrong");
# finally get new values
my(@ok,@bad);
my $correct=correct(@attrs,%defaults,map {$_=>"$_ set value"} @attrs);
for my $attr (@attrs) {
  my $after=$object->$attr;
  eq_deeply($after,$correct->{$attr})? push(@ok,$attr): push(@bad,$attr);
}
report(!@bad,'get new values one-by-one',__FILE__,__LINE__,"attributes '@bad' wrong");

# get class attributes by class
my(@ok,@bad);
my $correct=correct(@class_attrs,%defaults,map {$_=>"$_ set value"} @class_attrs);
for my $attr (@class_attrs) {
  my $after=autoclass_010::Parent->$attr;
  eq_deeply($after,$correct->{$attr})? push(@ok,$attr): push(@bad,$attr);
}
report(!@bad,'get class attributes via class one-by-one',__FILE__,__LINE__,"attributes '@bad' wrong");

# set attributes in 'new' - one at a time
my(@ok,@bad);
for my $attr (@attrs) {
  my $value="$attr new value";
  my $object=new autoclass_010::Parent $attr=>$value;
  # note: this sets class attributes to previous value unless being set here
  # makes sure 'other' attribute set to new value even if default
  $value=[$value] if $attr=~/^other/;
  my $correct=correct(@attrs,%defaults,
		      (map {$_=>autoclass_010::Parent->$_} @class_attrs),
		      $attr=>$value);
  cmp_object($object,$correct,"set attribute $attr via new",'quiet')? 
    push(@ok,$attr): push(@bad,$attr);
}
report(!@bad,'set attributes via new one-by-one',__FILE__,__LINE__,"attributes '@bad' wrong");

# set attributes in 'new' - all at once
my %args=map {$_=>"$_ new value"} @attrs;
my $object=new autoclass_010::Parent %args;
my $correct=correct(@attrs,%defaults,
		    (map {$_=>/^other/? ["$_ new value"]: "$_ new value"}
		     @attrs));
cmp_object($object,$correct,"set attributes via new all at once");

# set attributes via 'set' method - one at a time
my(@ok,@bad);
for my $attr (@attrs) {
  my $value="$attr set value";
  my $object=new autoclass_010::Parent;
  $object->set($attr=>$value);
  # note: this sets class attributes to previous value unless being set here
  my $correct=correct(@attrs,%defaults,
		      (map {$_=>autoclass_010::Parent->$_} @class_attrs),
		      $attr=>$value);
  cmp_object($object,$correct,"set attribute $attr via set",'quiet')? 
    push(@ok,$attr): push(@bad,$attr);
}
report(!@bad,'set attributes via set one-by-one',__FILE__,__LINE__,"attributes '@bad' wrong");

# set attributes via 'set' - all at once
my %args=map {$_=>"$_ set value"} @attrs;
my $object=new autoclass_010::Parent;
$object->set(%args);
my $correct=correct(@attrs,%defaults, (map {$_=>"$_ set value"} @attrs));
cmp_object($object,$correct,"set attributes via set all at once");

# set attributes via 'set_attribuutes' method - one at a time
my(@ok,@bad);
my %args=map {$_=>"$_ set value"} @attrs;
my $args=new Hash::AutoHash::Args %args;
for my $attr (@attrs) {
  my $value="$attr set value";
  my $object=new autoclass_010::Parent;
  $object->set_attributes([$attr],$args);
  # note: this sets class attributes to previous value unless being set here
  my $correct=correct(@attrs,%defaults,
		      (map {$_=>autoclass_010::Parent->$_} @class_attrs),
		      $attr=>$value);
  cmp_object($object,$correct,"set attribute $attr via set_attributes",'quiet')? 
    push(@ok,$attr): push(@bad,$attr);
}
report(!@bad,'set attributes via set_attributes one-by-one',
       __FILE__,__LINE__,"attributes '@bad' wrong");

# set attributes via 'set_attributes' - all at once
my %args=map {$_=>"$_ set value"} @attrs;
my $args=new Hash::AutoHash::Args %args;
my $correct=correct(@attrs,%defaults, (map {$_=>"$_ set value"} @attrs));
my $object=new autoclass_010::Parent;
$object->set_attributes(\@attrs,$args);
cmp_object($object,$correct,"set attributes via set_attributes all at once");

# do it again with some superfluous attributes.
my $object=new autoclass_010::Parent;
$object->set_attributes([@attrs,qw(fee fie foe fum)],$args);
cmp_object($object,$correct,"set attributes via set_attributes with superfluous attributes");

# get attributes via 'get' method - one at a time
# first set 'em all
my $object=new autoclass_010::Parent;
$object->set(map {$_=>"$_ set value"} @attrs);
# now get 'em one-by-one
my(@ok,@bad);
my $correct=correct(@attrs,%defaults,map {$_=>"$_ set value"} @attrs);
for my $attr (@attrs) {
  my $actual=$object->get($attr);
  eq_deeply($actual,$correct->{$attr})? push(@ok,$attr): push(@bad,$attr);
}
report(!@bad,'get new values via get one-by-one',__FILE__,__LINE__,"attributes '@bad' wrong");

# get attributes via 'get' - all at once
# first set 'em all
my $object=new autoclass_010::Parent;
$object->set(map {$_=>"$_ set value"} @attrs);
# now get 'em all at once
my $actual;
@$actual{@attrs}=$object->get(@attrs);
cmp_values($actual,$correct,'get new values via get all at once');

done_testing();