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