Blame t/07_uplevel_too_high.t
|
Packit |
cde0b4 |
#!/usr/bin/perl
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
use strict;
|
|
Packit |
cde0b4 |
BEGIN { $^W = 1 }
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
use Test::More tests => 5;
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
BEGIN {
|
|
Packit |
cde0b4 |
$Sub::Uplevel::CHECK_FRAMES = 1;
|
|
Packit |
cde0b4 |
use_ok('Sub::Uplevel');
|
|
Packit |
cde0b4 |
}
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
sub show_caller {
|
|
Packit |
cde0b4 |
return scalar caller;
|
|
Packit |
cde0b4 |
}
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
sub wrap_show_caller {
|
|
Packit |
cde0b4 |
my $uplevel = shift;
|
|
Packit |
cde0b4 |
return uplevel $uplevel, \&show_caller;
|
|
Packit |
cde0b4 |
}
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
my $warning = '';
|
|
Packit |
cde0b4 |
local $SIG{__WARN__} = sub { $warning = shift };
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
my $caller = wrap_show_caller(1);
|
|
Packit |
cde0b4 |
is($caller, 'main', "wrapper returned correct caller");
|
|
Packit |
cde0b4 |
is( $warning, '', "don't warn if ordinary uplevel" );
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
$warning = '';
|
|
Packit |
cde0b4 |
$caller = wrap_show_caller(2);
|
|
Packit |
cde0b4 |
my $file = __FILE__;
|
|
Packit |
cde0b4 |
is($caller, undef, "wrapper returned correct caller");
|
|
Packit |
cde0b4 |
like( $warning, qr/uplevel 2 is more than the caller stack/, "warn if too much uplevel" );
|