#!/usr/bin/perl
use strict;
BEGIN { $^W = 1 }
use Test::More tests => 7;
# Goal of these tests: confirm that Sub::Uplevel will honor (use) a
# CORE::GLOBAL::caller that occurs after Sub::Uplevel is loaded
#--------------------------------------------------------------------------#
# define a custom caller function that reverses the package name
#--------------------------------------------------------------------------#
sub _reverse_caller(;$) {
my $height = $_[0];
my @caller = CORE::caller(++$height);
$caller[0] = defined $caller[0] ? reverse $caller[0] : undef;
if( wantarray and !@_ ) {
return @caller[0..2];
}
elsif (wantarray) {
return @caller;
}
else {
return $caller[0];
}
}
#--------------------------------------------------------------------------#
# load Sub::Uplevel then redefine CORE::GLOBAL::caller
#--------------------------------------------------------------------------#
BEGIN {
ok( ! defined *CORE::GLOBAL::caller{CODE},
"no global override yet"
);
use_ok('Sub::Uplevel');
is( *CORE::GLOBAL::caller{CODE}, \&Sub::Uplevel::_normal_caller,
"Sub::Uplevel's normal caller override in place"
);
# old style no warnings 'redefine'
my $old_W = $^W;
$^W = 0;
*CORE::GLOBAL::caller = \&_reverse_caller;
$^W = $old_W
}
is( *CORE::GLOBAL::caller{CODE}, \&_reverse_caller,
"added new, custom caller override"
);
#--------------------------------------------------------------------------#
# define subs *after* caller has been redefined in BEGIN
#--------------------------------------------------------------------------#
sub test_caller { return scalar caller }
sub uplevel_caller { return uplevel 1, \&test_caller }
sub test_caller_w_uplevel { return uplevel_caller }
#--------------------------------------------------------------------------#
# Test for reversed package name both inside and outside an uplevel call
#--------------------------------------------------------------------------#
is( scalar caller(), undef,
"caller from main package is undef"
);
is( test_caller(), reverse("main"),
"caller from subroutine calls custom routine"
);
is( test_caller_w_uplevel(), reverse("main"),
"caller from uplevel subroutine calls custom routine"
);