1use lib qw(t);
2use Carp;
3use Hash::AutoHash::Args;
4use Hash::AutoHash::Args::V0;
5use Test::More;
6use Test::Deep;
7
8sub test_basics {
9  my($V)=@_;
10  my $args_class=$V? 'Hash::AutoHash::Args': 'Hash::AutoHash::Args::V0';
11  my $label=$V? 'V1': 'V0';
12  # test object class for sanity sake
13  my $args=new $args_class;
14  is(ref $args,$V? 'Hash::AutoHash::Args': 'Hash::AutoHash::Args::V0',
15     "$label class is $args_class - sanity check");
16
17  my($args, @list, @list2, @list3);
18  $args=new $args_class(-arg1=>'value11');
19  is($args->arg1,'value11',"$label one arg. initial value");
20  $args=new $args_class(-arg1=>'value11',-arg2=>'value21',-arg2=>'value22');
21  @list2=@{$args->arg2};
22  is($args->arg1,'value11',"$label single valued arg. initial value");
23  cmp_deeply(\@list2,['value21','value22'],"$label multivalued arg. initial value");
24  $args->arg1('changed value1');
25  $args->arg2('changed value2');
26  is($args->arg1,'changed value1',"$label single valued arg. changed value set by mutator");
27  is($args->arg2,'changed value2',"$label multivalued arg changed to single value. changed value set by mutator");
28  $args->arg3(qw(value31 value32 value33));
29  @list3=@{$args->arg3};
30  cmp_deeply(\@list3,['value31','value32','value33'],"$label multivalued arg set by mutator");
31
32  $args=new $args_class
33    (-ARG1=>'value11',
34     -ARG2=>'value21',-arg2=>'value22',
35     ArG3=>'value31','--arg3'=>'value32',-ARG3=>'value33',
36    );
37  @list2=@{$args->arg2};
38  @list3=@{$args->arg3};
39  is($args->arg1,'value11',"$label mixed case. 1-valued arg. initial value");
40  cmp_deeply(\@list2,['value21','value22'],"$label mixed case. 2-valued arg. initial value");
41  cmp_deeply(\@list3,['value31','value32','value33'],"$label mixed case. 3-valued arg. initial value");
42
43  $args=new $args_class([-arg1=>'value11']);
44  is($args->arg1,'value11',"$label ARRAY param");
45  $args=new $args_class({-arg1=>'value11'});
46  is($args->arg1,'value11',"$label HASH param");
47  $args=new $args_class($args);
48  is($args->arg1,'value11',"$label object param");
49
50  # non-existent arg should return nothing. (not undef);
51  $args=new $args_class(-arg1=>'value11');
52  @list=($args->arg0);
53  is(scalar @list,0,"$label non-existent arg");
54
55  #################################################################################
56  # test access via tied hash (ie, using hash notation)
57  #################################################################################
58  $args=new $args_class(-arg1=>'value11');
59  is($args->{'-ARG1'},'value11',"$label get via hash");
60  $args->{'-ArG1'}='value12';
61  is($args->arg1,'value12',"$label set via hash");
62  ok(exists $args->{'ARg1'},"$label exists via hash: true");
63  ok(!exists $args->{'arg2'},"$label exists via hash: false");
64  delete $args->{'ARg1'};
65  ok(!exists $args->{'arg1'},"$label delete via hash");
66
67  # non-existent arg should return nothing (not undef) but Perl doesn't do it this way!
68  $args=new $args_class(-arg1=>'value11');
69  @list=($args->{arg0});
70  is(scalar @list,1,"$label non-existent arg via hash");
71
72}
73
74test_basics(0);
75test_basics(1);
76
77done_testing();
78