Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

no Sub::Uplevel #2

Closed
wants to merge 1 commit into from

2 participants

@tobyink

This feature restores the built-in caller() function. It needs to be used with care, but can speed up code that uses Sub::Uplevel early on but doesn't need it later.

@dagolden
Owner

Thanks for taking a cut at writing this. My first reaction is that I think it's brittle. Sub::Uplevel is already something that is pretty crazy and this makes it even crazier. I'd rather see an XS implementation of the "normal" caller override instead to regain the speed when upleveling isn't in effect.

@dagolden
Owner

As I said, I think trying to reverse a global override is not a great idea. I'm going to close this request.

@dagolden dagolden closed this
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Apr 16, 2012
  1. @tobyink

    no Sub::Uplevel

    tobyink authored
This page is out of date. Refresh to see the latest.
Showing with 55 additions and 0 deletions.
  1. +2 −0  Changes
  2. +25 −0 lib/Sub/Uplevel.pm
  3. +28 −0 t/99_no_sub_uplevel.t
View
2  Changes
@@ -2,6 +2,8 @@ Changes for Sub::Uplevel
{{$NEXT}}
+ - add "no Sub::Uplevel"
+
0.24 2012-02-20 22:18:46 EST5EDT
- no changes from 0.23_03
View
25 lib/Sub/Uplevel.pm
@@ -21,6 +21,9 @@ if ( not defined *CORE::GLOBAL::caller{CODE} ) {
# modules to force reload if ":aggressive" is specified
my @reload_list = qw/Exporter Exporter::Heavy/;
+# keep track of where CORE::GLOBAL::caller was restored
+my $be_gone;
+
sub import {
no strict 'refs'; ## no critic
my ($class, @args) = @_;
@@ -49,6 +52,14 @@ sub _force_reload {
}
}
+sub unimport {
+ my $globals = do { no strict 'refs'; \%{'CORE::GLOBAL::'} };
+ delete $globals->{caller}
+ if *CORE::GLOBAL::caller{CODE} == \&_uplevel_caller
+ || *CORE::GLOBAL::caller{CODE} == \&_normal_caller;
+ $be_gone = [CORE::caller()];
+}
+
=head1 SYNOPSIS
use Sub::Uplevel;
@@ -135,6 +146,13 @@ sub _apparent_stack_height {
}
sub uplevel {
+ if ($be_gone) {
+ die
+ sprintf qq(uplevel disabled at %s line %d, but later called at %s line %d\n),
+ @{$be_gone}[1,2],
+ (caller)[1,2];
+ }
+
# Backwards compatible version of "no warnings 'redefine'"
my $old_W = $^W;
$^W = 0;
@@ -291,6 +309,13 @@ Well, the bad news is uplevel() is about 5 times slower than a normal
function call. XS implementation anyone? It also slows down every invocation
of caller(), regardless of whether uplevel() is in effect.
+There is experimental support for restoring Perl's built-in (faster)
+caller() implementation using C<< no Sub::Uplevel >> after you've finished
+using Sub::Uplevel. After doing this, caller() will be faster but any
+use of uplevel() B<anywhere> in your script (including modules) will croak.
+This is a one-time deal. Once you've called C<< no Sub::Uplevel >> once,
+no amount of work will bring uplevel() back again.
+
Sub::Uplevel overrides CORE::GLOBAL::caller temporarily for the scope of
each uplevel call. It does its best to work with any previously existing
CORE::GLOBAL::caller (both when Sub::Uplevel is first loaded and within
View
28 t/99_no_sub_uplevel.t
@@ -0,0 +1,28 @@
+use Test::More;
+use Sub::Uplevel;
+BEGIN {
+ eval 'use Time::HiRes qw(time); 1'
+ or plan skip_all => 'Need Time::HiRes.';
+}
+
+plan tests => 1;
+
+my @times1 = (time);
+for (0..10_000) {
+ my $x = $_ + (caller)[2];
+}
+push @times1, time;
+
+no Sub::Uplevel;
+
+my @times2 = (time);
+for (0..10_000) {
+ my $x = $_ + (caller)[2];
+}
+push @times2, time;
+
+diag "Timing results...";
+diag sprintf q(Sub::Uplevel's caller: %0.6f sec), $times1[1]-$times1[0];
+diag sprintf q(Built-in caller: %0.6f sec), $times2[1]-$times2[0];
+
+ok(!eval { uplevel 0, sub {}; 1 }, 'uplevel dies now');
Something went wrong with that request. Please try again.