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" );