1#!perl 2 3use Test::More tests => 30; 4 5BEGIN { use_ok 'Sub::Identify', ':all' } 6 7diag "running pure-Perl version of Sub::Identify" if $Sub::Identify::IsPurePerl; 8 9sub buffy { } 10sub vamp::spike { } 11*slayer = *buffy; 12*human::william = \&vamp::spike; 13 14is( sub_name( \&sub_name ), 'sub_name' ); 15is( sub_name( \&buffy ), 'buffy' ); 16is( sub_name( \&vamp::spike ), 'spike' ); 17is( sub_name( \&slayer ), 'buffy' ); 18is( sub_name( \&human::william ), 'spike' ); 19 20is( stash_name( \&stash_name ), 'Sub::Identify' ); 21is( stash_name( \&buffy ), 'main' ); 22is( stash_name( \&vamp::spike ), 'vamp' ); 23is( stash_name( \&slayer ), 'main' ); 24is( stash_name( \&human::william ), 'vamp' ); 25 26is( sub_fullname( \&sub_fullname ), 'Sub::Identify::sub_fullname' ); 27is( sub_fullname( \&buffy ), 'main::buffy' ); 28is( sub_fullname( \&vamp::spike ), 'vamp::spike' ); 29is( sub_fullname( \&slayer ), 'main::buffy' ); 30is( sub_fullname( \&human::william ), 'vamp::spike' ); 31 32is( join('*', get_code_info( \&sub_fullname )), 'Sub::Identify*sub_fullname' ); 33is( join('*', get_code_info( \&buffy )), 'main*buffy' ); 34is( join('*', get_code_info( \&vamp::spike )), 'vamp*spike' ); 35is( join('*', get_code_info( \&slayer )), 'main*buffy' ); 36is( join('*', get_code_info( \&human::william )), 'vamp*spike' ); 37 38sub xander; 39sub vamp::drusilla; 40is( sub_name( \&xander ), 'xander', 'undefined subroutine' ); 41is( sub_fullname( \&xander ), 'main::xander', 'undefined subroutine' ); 42is( join('*', get_code_info( \&xander )), 'main*xander', 'undefined subroutine' ); 43is( sub_name( \&vamp::drusilla ), 'drusilla', 'undefined subroutine' ); 44is( sub_fullname( \&vamp::drusilla ), 'vamp::drusilla', 'undefined subroutine' ); 45 46is( sub_name( sub {} ), '__ANON__' ); 47my $anon = sub {}; 48is( stash_name( $anon ), 'main' ); 49is( sub_fullname( $anon ), 'main::__ANON__' ); 50is( join('*', get_code_info( sub { 'ah non' } )), 'main*__ANON__' ); 51