Auto-merging (0, 27908) /local/Sub-Uplevel to /vendor/Sub-Uplevel (base /vendor/Sub-Uplevel:27906).
U t/02_uplevel.t
U lib/Sub/Uplevel.pm
==== Patch <-> level 1
Source: 9c88509d-e914-0410-b01c-b9530614cbfe:/local/Sub-Uplevel:27908
Target: 9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/Sub-Uplevel:27906
Log:
r27907@windhund: schwern | 2007-04-04 11:48:39 -0400
Local copy
r27908@windhund: schwern | 2007-04-04 12:59:59 -0400
Fix uplevel() so it no longer needs a global caller override so it can
plan nice with things like Contextual::Return.
=== t/02_uplevel.t
==================================================================
--- t/02_uplevel.t (revision 27906)
+++ t/02_uplevel.t (patch - level 1)
@@ -2,7 +2,7 @@
use lib qw(t/lib);
use strict;
-use Test::More tests => 20;
+use Test::More tests => 22;
BEGIN { use_ok('Sub::Uplevel'); }
can_ok('Sub::Uplevel', 'uplevel');
@@ -128,6 +128,22 @@
['main', $0, 122, 'main::caller_check' ],
'caller check' );
+is( (() = caller_check(0)), (() = core_caller_check(0)) ,
+ "caller() with args returns right number of values"
+);
+
+sub core_caller_no_args {
+ return CORE::caller();
+}
+
+sub caller_no_args {
+ return caller();
+}
+
+is( (() = caller_no_args()), (() = core_caller_no_args()),
+ "caller() with no args returns right number of values"
+);
+
sub deep_caller {
return caller(1);
}
@@ -141,7 +157,7 @@
sub deeper { deep_caller() } # caller 0
sub still_deeper { deeper() } # caller 1 -- should give this line, 137
-sub ever_deeper { still_deeper } # caller 2
+sub ever_deeper { still_deeper() } # caller 2
is_deeply([(ever_deeper)[0..2]], ['main', $0, 137], 'deep caller()' );
=== lib/Sub/Uplevel.pm
==================================================================
--- lib/Sub/Uplevel.pm (revision 27906)
+++ lib/Sub/Uplevel.pm (patch - level 1)
@@ -6,8 +6,9 @@
use vars qw($VERSION @ISA @EXPORT);
$VERSION = "0.14";
-# We have to do this so the CORE::GLOBAL versions override the builtins
-_setup_CORE_GLOBAL();
+# We must touch *CORE::GLOBAL::caller or else Perl won't see
+# a later override.
+*CORE::GLOBAL::caller = \&_normal_caller;
require Exporter;
@ISA = qw(Exporter);
@@ -78,20 +79,31 @@
my($num_frames, $func, @args) = @_;
local @Up_Frames = ($num_frames, @Up_Frames );
+
+ no warnings 'redefine';
+ local *CORE::GLOBAL::caller = \&_uplevel_caller;
+
return $func->(@args);
}
+sub _normal_caller (;$) {
+ my $height = $_[0];
+ $height++;
+ if( wantarray and !@_ ) {
+ return (CORE::caller($height))[0..2];
+ }
+ else {
+ return CORE::caller($height);
+ }
+}
-sub _setup_CORE_GLOBAL {
- no warnings 'redefine';
+sub _uplevel_caller (;$) {
+ my $height = $_[0] || 0;
- *CORE::GLOBAL::caller = sub(;$) {
- my $height = $_[0] || 0;
+ # shortcut if no uplevels have been called
+ # always add +1 to CORE::caller to skip this function's caller
+ return CORE::caller( $height + 1 ) if ! @Up_Frames;
- # shortcut if no uplevels have been called
- # always add +1 to CORE::caller to skip this function's caller
- return CORE::caller( $height + 1 ) if ! @Up_Frames;
-
=begin _private
So it has to work like this:
@@ -142,36 +154,34 @@
=cut
- my $saw_uplevel = 0;
- my $adjust = 0;
+ my $saw_uplevel = 0;
+ my $adjust = 0;
- # walk up the call stack to fight the right package level to return;
- # look one higher than requested for each call to uplevel found
- # and adjust by the amount found in the Up_Frames stack for that call
+ # walk up the call stack to fight the right package level to return;
+ # look one higher than requested for each call to uplevel found
+ # and adjust by the amount found in the Up_Frames stack for that call
- for ( my $up = 0; $up <= $height + $adjust; $up++ ) {
- my @caller = CORE::caller($up + 1);
- if( defined $caller[0] && $caller[0] eq __PACKAGE__ ) {
- # add one for each uplevel call seen
- # and look into the uplevel stack for the offset
- $adjust += 1 + $Up_Frames[$saw_uplevel];
- $saw_uplevel++;
- }
+ for ( my $up = 0; $up <= $height + $adjust; $up++ ) {
+ my @caller = CORE::caller($up + 1);
+ if( defined $caller[0] && $caller[0] eq __PACKAGE__ ) {
+ # add one for each uplevel call seen
+ # and look into the uplevel stack for the offset
+ $adjust += 1 + $Up_Frames[$saw_uplevel];
+ $saw_uplevel++;
}
+ }
- my @caller = CORE::caller($height + $adjust + 1);
+ my @caller = CORE::caller($height + $adjust + 1);
- if( wantarray ) {
- if( !@_ ) {
- @caller = @caller[0..2];
- }
- return @caller;
+ if( wantarray ) {
+ if( !@_ ) {
+ @caller = @caller[0..2];
}
- else {
- return $caller[0];
- }
- }; # sub
-
+ return @caller;
+ }
+ else {
+ return $caller[0];
+ }
}
=back
@@ -202,8 +212,7 @@
Well, the bad news is uplevel() is about 5 times slower than a normal
function call. XS implementation anyone?
-Blows over any CORE::GLOBAL::caller you might have (and if you do,
-you're just sick).
+If you have your own CORE::GLOBAL::caller() override (such as using Contextual::Return) it won't work inside an uplevel().
=head1 HISTORY
==== BEGIN SVK PATCH BLOCK ====
Version: svk v2.0.1 (darwin)
eJyNVktv20YQ5pnouT0VmCZMLFWxzTcpKRbUBEnR1s07uaStsCKXFmuaq5JLyUZpQHkghxYIWqCn
Am0vvfTW/sPOLklZSpTYAmGTuzPffjP7zezezh71h0Y5GOilZujlwydf9Xr3CA8mVwy71NyShjFn
meaUCZ3RRLPKhB1odpmSI4qzOSuyQLxwkh1QLl7i4JDywcBAOL+CuyUhGliJOiacpbnWlfAjnlGq
GaU79MqhJZ6RZnTLnOKMhB1ldBbnMUuRhul1dR9N0N5Afzal6ShjjC+nTOGtl0HCcjoS8ALSEfam
hiFJhzDOaICcTnCUS6TGWxraGwwx8Hi8ZippOvVCq4gGcqiArIZhFCdUgPJd3RwVU5nLHS45nQtn
VnBylkynycmI02Me0oQTuYRllhHRPc/ybdr1g3Bs2bprWL7h2r5LA9Oy0cZzcS/uKMrvxR9ffvj8
ifK18kz55fjO4vl95fn9X2+8VF5999tHZpy3oNVqwx4EJEloNgomNDhs6e32tWacZXT05iRcUwF/
l6pxtJvHfAK4dTlklBdZiv/jgwmHtDga0wxYBDOSFDS/pLb7qpoX4zXclI2k748StUKAm3cf3Or1
mhX66mnt9x6XNeO3QqtdWptjW5ndFFvKLhYe2p8O7VVFVkqots2zja5vezoJqD4ObEoNx/Ft4jhd
Q7c9113qyNkgSE8IcvdhMZaCPVdF9hLMXRel3+DsPq51OT2SS54L6bxXmK6I0HB9O/IMYjoudake
+aHlUcO3iDt2UK0exuX5lTL/Vf67uvPzB0qiLLjy0/jZzcWLWHm9+/r64pmn3P3TXQTK/l988eJj
5eXx353FsfJK/Wd2VOQcOCuCCXxaKeTz/bs3PttvlAIsA5rkFO7RLIE5S7c45JSql4FAQrgwmNEs
i0O6o24G2INvrqIasiOS1NqQekABzEmWximKYCujIY3ilG715VzC0PAdfCRc3QBqPKyAFdFqUZEG
24PWUOjrTOfrFKDV19q12I9OQJtQqb890EZP9W8rFvVgp1N9xlELGafYUDNyAiQN4ZPhCBqQFQKt
tUqrUdrtp/rOjllDn8q/Mq9vuW/0btyaYNYT8P5ooCxBr3N0GfIJy3hQcIxH7EENlMOEzCiMKa2r
PqzNSTInJzmQMISOgUJZoye+88N4CnwS5yDyzvGM2crrDqEKLjmZN2yRkN5fkiTh90J7eyvc5iQ5
REYIRyUE5JwEh2KVSAYkxqtGMcVxckChwkWDKnn9Gihh7BBYSmGC1oLnhKRo8gO2FE5DiISoCUpe
LsKXWcCJIg1VMd2SHJGL4Cdfru8tE9tp2MuZTmdNBeg3XGp1fTMRpQNGuw+ifDCjguGSS8OhChw3
YolY7wQqTsYVp8hYpKLxqLIkgMQoiyI8+Necm1x39sAQ5B9PR7czvH/kT1e3p9bm0mllqqmBM+2e
qs1GvivYN3NVha5uqKXV7ImZN+tK/M5Wqd9Wy+mM1kodDZvmcF7BaQ1gU5xfRHDCiqoi8AVb3Lwp
y/VmhIdT0/2glYseSnIocuxpcJOlopcXJOn1Hsh12hDzuoHOWSa2MRd+KMw6ya2N55w8BUKDesRy
otDTLcsKSegFnu8YuutHkRtRQ16rTNssIRNHjjecx2k4QS33APJgMqcYZgmmrnvbuo0PGEbP9ntW
F/BD11XYlx03YNMTtYLwz4cwe04Xnwbidny8jKQNORPhYoNJWHqA+5ZSGmIbgYOEjUkCzeHSZK8y
DwiKfppgStI4oNVFAVuLOCKS+JBuSOqOiqFvDwZmqZlmdVl+JG+8vd7jNEb0nCRX3BLv21PCJ3gH
xYswfhRFHIqDe1eeNOLs3q7P7ubQ1iy37Aa+7+jdcJt2DRGyoW+PdSPYHncdCy+IdjCO6KBtlu9c
oFvuzmgasmzDCu5FV9Bc40J2vbeD6clQ/gdWVeKl
==== END SVK PATCH BLOCK ====
