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