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