1use lib qw(t/lib); 2use strict; 3use Test::More tests => 5; 4 5BEGIN { use_ok('Sub::Uplevel'); } 6 7sub show_caller { 8 return scalar caller; 9} 10 11sub wrap_show_caller { 12 my $uplevel = shift; 13 return uplevel $uplevel, \&show_caller; 14} 15 16my $warning = ''; 17local $SIG{__WARN__} = sub { $warning = shift }; 18 19my $caller = wrap_show_caller(1); 20is($caller, 'main', "wrapper returned correct caller"); 21is( $warning, '', "don't warn if ordinary uplevel" ); 22 23$warning = ''; 24$caller = wrap_show_caller(2); 25my $file = __FILE__; 26is($caller, undef, "wrapper returned correct caller"); 27like( $warning, qr/uplevel 2 is more than the caller stack/, "warn if too much uplevel" ); 28