X-Git-Url: http://vcs.maemo.org/git/?a=blobdiff_plain;f=dev%2Fi386%2Flibsub-uplevel-perl%2Flibsub-uplevel-perl-0.1901%2Ft%2F05_honor_prior_override.t;fp=dev%2Fi386%2Flibsub-uplevel-perl%2Flibsub-uplevel-perl-0.1901%2Ft%2F05_honor_prior_override.t;h=f8282c2e3376a93765109768604f109f05c0e389;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hp=0000000000000000000000000000000000000000;hpb=df794b845212301ea0d267c919232538bfef356a;p=dh-make-perl

diff --git a/dev/i386/libsub-uplevel-perl/libsub-uplevel-perl-0.1901/t/05_honor_prior_override.t b/dev/i386/libsub-uplevel-perl/libsub-uplevel-perl-0.1901/t/05_honor_prior_override.t
new file mode 100644
index 0000000..f8282c2
--- /dev/null
+++ b/dev/i386/libsub-uplevel-perl/libsub-uplevel-perl-0.1901/t/05_honor_prior_override.t
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -Tw
+
+use lib qw(t/lib);
+use strict;
+use Test::More tests => 7;
+
+# Goal of these tests: confirm that Sub::Uplevel will honor (use) a
+# CORE::GLOBAL::caller override that occurs prior to Sub::Uplevel loading
+
+#--------------------------------------------------------------------------#
+# define a custom caller function that reverses the package name
+#--------------------------------------------------------------------------#
+
+sub _reverse_caller(;$) { 
+    my $height = $_[0];
+    my @caller = CORE::caller(++$height);
+    $caller[0] = reverse $caller[0];
+    if( wantarray and !@_ ) {
+        return @caller[0..2];
+    }
+    elsif (wantarray) {
+        return @caller;
+    }
+    else {
+        return $caller[0];
+    }
+}
+
+#--------------------------------------------------------------------------#
+# redefine CORE::GLOBAL::caller then load Sub::Uplevel 
+#--------------------------------------------------------------------------#
+
+BEGIN {
+    ok( ! defined *CORE::GLOBAL::caller{CODE}, 
+        "no global override yet" 
+    );
+
+    {
+        # 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 custom caller override"
+    );
+
+    use_ok('Sub::Uplevel');
+
+    is( *CORE::GLOBAL::caller{CODE}, \&_reverse_caller,
+        "custom caller override still in place"
+    );
+
+
+}
+
+#--------------------------------------------------------------------------#
+# 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(), '',
+    "caller from main package is empty string"
+);
+
+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"
+);
+