1use lib qw(t); 2 3use strict; 4use Carp; 5use Test::More; 6# use Test::Deep; # CAUTION: Test::Deep defines 'isa'. breaks 'isa' tests below 7# use Tie::Hash::MultiValue; # an example tied hash class 8use autohashUtil; 9use Hash::AutoHash; 10 11require "autohash.050.subclass.pm"; # defines classes Child, Grandchild 12my $autohash_class='Hash::AutoHash'; 13my $child_class='Child'; 14 15# import Hash::AutoHash qw(autohash_new); 16# my $autohash=autohash_new(); 17# ok($autohash && (ref($autohash) eq $autohash_class),'import autohash function via base class'); 18 19################################################################################ 20# test computation of @EXPORT_OK, @SUBCLASS_EXPORT_OK, %EXPORT_OK 21################################################################################ 22my @export_ok=qw(autohash_new child_new not_defined 23 child_xxx 24 child_autohash_new child_child_new); 25my @subclass_export_ok=@export_ok; 26my %export_ok= 27 (autohash_new=>'Hash::AutoHash::helper::autohash_new', 28 child_autohash_new=>'Hash::AutoHash::helper::autohash_new', 29 child_child_new=>'Child::helper::child_new', 30 child_new=>'Child::helper::child_new', 31 child_xxx=>'Hash::AutoHash::helper::autohash_keys', 32 not_defined=>undef); 33cmp_set(\@Child::EXPORT_OK,\@export_ok,'Child @EXPORT_OK'); 34cmp_set(\@Child::SUBCLASS_EXPORT_OK,\@subclass_export_ok,'Child @SUBCLASS_EXPORT_OK'); 35cmp_deeply(\%Child::EXPORT_OK,\%export_ok,'Child %EXPORT_OK'); 36 37################################################################################# 38# test Child UNIVERSAL methods 39################################################################################# 40my $child=new Child; 41ok($child,'Child new'); 42 43my $can=can Child('can'); 44ok($can,'Child can: can'); 45my $can=can Child('child_method'); 46ok($can,'Child can: child_method'); 47my $can=can Child('not_defined'); 48ok(!$can,'Child can: can\'t'); 49my $can=$child->can('can'); 50ok($can,'Child object can: can'); 51my $can=$child->can('not_defined'); 52ok(!$can,'Child object can: can\'t'); 53 54my $isa=isa Child('Child'); 55ok($isa,'Child isa: is Child'); 56my $isa=isa Child('Hash::AutoHash'); 57ok($isa,'Child isa: is Hash::AutoHash'); 58my $isa=isa Child('UNIVERSAL'); 59ok($isa,'Child isa: is UNIVERSAL'); 60my $isa=isa Child('not_defined'); 61ok(!$isa,'Child isa: isn\'t'); 62my $isa=$child->isa('Child'); 63ok($isa,'Child object isa: is Child'); 64my $isa=$child->isa('not_defined'); 65ok(!$isa,'Child object isa: isn\'t'); 66 67# Test DOES in perls > 5.10. 68# Note: $^V returns real string in perls > 5.10, and v-string in earlier perls 69# regexp below fails in earlier perls. this is okay 70my($perl_main,$perl_minor)=$^V=~/^v(\d+)\.(\d+)/; # perl version 71if ($perl_main==5 && $perl_minor>=10) { 72 my $does=DOES Child('Child'); 73 is($does,1,'Child DOES: is Child'); 74 my $does=DOES Child('Hash::AutoHash'); 75 ok($does,'Child DOES: is Hash::AutoHash'); 76 my $does=DOES Child('UNIVERSAL'); 77 is($does,1,'Child DOES: is UNIVERSAL'); 78 my $does=DOES Child('not_defined'); 79 ok(!$does,'Child DOES: doesn\'t'); 80 my $does=$child->DOES('Child'); 81 is($does,1,'Child object DOES: is Child'); 82 my $does=$child->DOES('not_defined'); 83 ok(!$does,'Child object DOES: doesn\'t'); 84} 85 86my $version=VERSION Child; 87is($version,$Child::VERSION,'Child VERSION'); 88is($child->VERSION,$version,'Child object VERSION'); 89 90import Child qw(autohash_new); 91# NOTE: $autohash used as global in autohashUtil test functions. do NOT 'my' it!! 92$autohash=autohash_new(); 93ok($autohash && (ref($autohash) eq $autohash_class),'import autohash function via Child'); 94import Child qw(child_new); 95my $child=child_new(); 96ok($child && (ref($child) eq $child_class),'import child function via Child'); 97 98eval {import Child qw(import);}; 99ok($@=~/not exported/,'import autohash function via Child: not exported'); 100eval {import Child qw(child_function_not_exported);}; 101ok($@=~/not exported/,'import child function via Child: not exported'); 102eval {import Child qw(not_defined);}; 103ok($@=~/not defined/,'import via Child: not defined'); 104 105import Child qw(child_autohash_new); 106$autohash=child_autohash_new(); 107ok($autohash && (ref($autohash) eq $autohash_class),'import renamed autohash function via Child'); 108import Child qw(child_child_new); 109my $child=child_child_new(); 110ok($child && (ref($child) eq $child_class),'import renamed child function via Child'); 111 112use Test::Deep; 113import Child qw(child_xxx); 114my $child=new Child(key1=>'value10',key2=>'value20',key3=>'value30'); 115my @actual=child_xxx($child); # keys 116my @correct=qw(key1 key2 key3); 117cmp_set(\@actual,\@correct,"import renamed autohash function via Child \%RENAME_EXPORT_OK"); 118 119################################################################################# 120# test Child keys, AUTOLOADED methods, real method 121################################################################################# 122$autohash=new Child (key1=>'value10',key2=>'value20'); 123cmp_autohash('Child: 0th values',[undef,'value10','value20']); 124$autohash->key1('value11'); 125$autohash->key2('value21'); 126cmp_autohash('Child: 1st values',[undef,'value11','value21']); 127$autohash->key1('value12'); 128$autohash->key2('value22'); 129cmp_autohash('Child: 2nd values',[undef,'value12','value22']); 130is($autohash->child_method,'child method','Child: real child method'); 131 132################################################################################# 133# test Child special keys 134################################################################################# 135# test_subclass_special_keys(Child); 136test_special_keys(new Child); 137 138done_testing(); 139