|
Packit |
cde0b4 |
#!/usr/bin/perl
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
use strict;
|
|
Packit |
cde0b4 |
BEGIN { $^W = 1 }
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
use Test::More tests => 10;
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
# Goal of these tests: confirm that Sub::Uplevel will honor (use) a
|
|
Packit |
cde0b4 |
# CORE::GLOBAL::caller override that occurs prior to Sub::Uplevel loading
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
#--------------------------------------------------------------------------#
|
|
Packit |
cde0b4 |
# define a custom caller function that increments a counter
|
|
Packit |
cde0b4 |
#--------------------------------------------------------------------------#
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
my $caller_counter = 0;
|
|
Packit |
cde0b4 |
sub _count_caller(;$) {
|
|
Packit |
cde0b4 |
$caller_counter++;
|
|
Packit |
cde0b4 |
my $height = $_[0];
|
|
Packit |
cde0b4 |
my @caller = CORE::caller(++$height);
|
|
Packit |
cde0b4 |
if( wantarray and !@_ ) {
|
|
Packit |
cde0b4 |
return @caller[0..2];
|
|
Packit |
cde0b4 |
}
|
|
Packit |
cde0b4 |
elsif (wantarray) {
|
|
Packit |
cde0b4 |
return @caller;
|
|
Packit |
cde0b4 |
}
|
|
Packit |
cde0b4 |
else {
|
|
Packit |
cde0b4 |
return $caller[0];
|
|
Packit |
cde0b4 |
}
|
|
Packit |
cde0b4 |
}
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
#--------------------------------------------------------------------------#
|
|
Packit |
cde0b4 |
# redefine CORE::GLOBAL::caller then load Sub::Uplevel
|
|
Packit |
cde0b4 |
#--------------------------------------------------------------------------#
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
BEGIN {
|
|
Packit |
cde0b4 |
ok( ! defined *CORE::GLOBAL::caller{CODE},
|
|
Packit |
cde0b4 |
"no global override yet"
|
|
Packit |
cde0b4 |
);
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
{
|
|
Packit |
cde0b4 |
# old style no warnings 'redefine'
|
|
Packit |
cde0b4 |
my $old_W = $^W;
|
|
Packit |
cde0b4 |
$^W = 0;
|
|
Packit |
cde0b4 |
*CORE::GLOBAL::caller = \&_count_caller;
|
|
Packit |
cde0b4 |
$^W = $old_W;
|
|
Packit |
cde0b4 |
}
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
is( *CORE::GLOBAL::caller{CODE}, \&_count_caller,
|
|
Packit |
cde0b4 |
"added custom caller override"
|
|
Packit |
cde0b4 |
);
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
use_ok('Sub::Uplevel');
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
is( *CORE::GLOBAL::caller{CODE}, \&_count_caller,
|
|
Packit |
cde0b4 |
"custom caller override still in place"
|
|
Packit |
cde0b4 |
);
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
}
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
#--------------------------------------------------------------------------#
|
|
Packit |
cde0b4 |
# define subs *after* caller has been redefined in BEGIN
|
|
Packit |
cde0b4 |
#--------------------------------------------------------------------------#
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
sub test_caller { return scalar caller }
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
sub uplevel_caller { return uplevel 1, \&test_caller }
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
sub test_caller_w_uplevel { return uplevel_caller }
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
#--------------------------------------------------------------------------#
|
|
Packit |
cde0b4 |
# Test for reversed package name both inside and outside an uplevel call
|
|
Packit |
cde0b4 |
#--------------------------------------------------------------------------#
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
my $old_caller_counter;
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
$old_caller_counter = $caller_counter;
|
|
Packit |
cde0b4 |
is( scalar caller(), undef,
|
|
Packit |
cde0b4 |
"caller from main package is undef"
|
|
Packit |
cde0b4 |
);
|
|
Packit |
cde0b4 |
ok( $caller_counter > $old_caller_counter, "custom caller() was used" );
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
$old_caller_counter = $caller_counter;
|
|
Packit |
cde0b4 |
is( test_caller(), "main",
|
|
Packit |
cde0b4 |
"caller from subroutine is main"
|
|
Packit |
cde0b4 |
);
|
|
Packit |
cde0b4 |
ok( $caller_counter > $old_caller_counter, "custom caller() was used" );
|
|
Packit |
cde0b4 |
|
|
Packit |
cde0b4 |
$old_caller_counter = $caller_counter;
|
|
Packit |
cde0b4 |
is( test_caller_w_uplevel(), "main",
|
|
Packit |
cde0b4 |
"caller from uplevel subroutine is main"
|
|
Packit |
cde0b4 |
);
|
|
Packit |
cde0b4 |
ok( $caller_counter > $old_caller_counter, "custom caller() was used" );
|
|
Packit |
cde0b4 |
|