r27207 - in /branches/upstream/libsub-uplevel-perl/current: ./ lib/Sub/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sun Nov 23 14:00:27 UTC 2008
Author: gregoa
Date: Sun Nov 23 14:00:23 2008
New Revision: 27207
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27207
Log:
[svn-upgrade] Integrating new upstream version, libsub-uplevel-perl (0.2002)
Added:
branches/upstream/libsub-uplevel-perl/current/t/07_uplevel_too_high.t
Modified:
branches/upstream/libsub-uplevel-perl/current/Build.PL
branches/upstream/libsub-uplevel-perl/current/Changes
branches/upstream/libsub-uplevel-perl/current/MANIFEST
branches/upstream/libsub-uplevel-perl/current/MANIFEST.SKIP
branches/upstream/libsub-uplevel-perl/current/META.yml
branches/upstream/libsub-uplevel-perl/current/Makefile.PL
branches/upstream/libsub-uplevel-perl/current/README
branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pm
branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pod
branches/upstream/libsub-uplevel-perl/current/t/02_uplevel.t
branches/upstream/libsub-uplevel-perl/current/t/04_honor_later_override.t
branches/upstream/libsub-uplevel-perl/current/t/05_honor_prior_override.t
Modified: branches/upstream/libsub-uplevel-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/Build.PL?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/Build.PL (original)
+++ branches/upstream/libsub-uplevel-perl/current/Build.PL Sun Nov 23 14:00:23 2008
@@ -1,3 +1,4 @@
+use 5.006;
use strict;
use lib 'inc';
eval "require Pod::WikiDoc";
@@ -11,7 +12,7 @@
create_readme => 1,
create_makefile_pl => 'traditional',
requires => {
- 'Exporter' => 0,
+ 'perl' => 5.006,
},
build_requires => {
'Carp' => 0,
Modified: branches/upstream/libsub-uplevel-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/Changes?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/Changes (original)
+++ branches/upstream/libsub-uplevel-perl/current/Changes Sun Nov 23 14:00:23 2008
@@ -1,8 +1,33 @@
Changes for Sub::Uplevel
+
+0.2002 Thu Sep 11 14:33:09 EDT 2008
+
+ - changed: removed Exporter dependency
+
+ - test fix: fixed strange t/07_uplevel_too_high.t fail on Win32
+
+0.2001 Tue Sep 9 22:22:40 EDT 2008
+
+ - test fix: changed prior override test to be more robust (SCHWERN)
+
+0.20 Tue Sep 9 19:23:35 EDT 2008
+
+ - changed: bumped perl requirement to 5.006 and stopped using vars
+ (fixes a test bug under Test::More > 0.80)
+
+0.19_03 Fri Jul 4 13:31:21 EDT 2008
+
+ - fixed: load Carp only as needed (fixes problem on 5.005)
+
+0.19_02 Thu Feb 21 14:58:46 EST 2008
+
+ - added: uplevel will warn if uplevel request is more than the call
+ stack depth
0.1901 Thu Feb 14 14:07:37 EST 2008
- - hides the "DB" package from indexers (DB used to support @DB::args)
+ - fixed: hides the "DB" package from indexers (DB used to support
+ @DB::args)
0.19 Thu Feb 14 11:50:16 EST 2008
Modified: branches/upstream/libsub-uplevel-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/MANIFEST?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/MANIFEST (original)
+++ branches/upstream/libsub-uplevel-perl/current/MANIFEST Sun Nov 23 14:00:23 2008
@@ -17,6 +17,7 @@
t/04_honor_later_override.t
t/05_honor_prior_override.t
t/06_db_args.t
+t/07_uplevel_too_high.t
t/lib/Foo.pm
Todo
xt/critic.t
Modified: branches/upstream/libsub-uplevel-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/MANIFEST.SKIP?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libsub-uplevel-perl/current/MANIFEST.SKIP Sun Nov 23 14:00:23 2008
@@ -3,6 +3,7 @@
\bCVS\b
,v$
.svn/
+^.git
# ExtUtils::MakeMaker generated files and dirs.
^MANIFEST\.(?!SKIP)
Modified: branches/upstream/libsub-uplevel-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/META.yml?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/META.yml (original)
+++ branches/upstream/libsub-uplevel-perl/current/META.yml Sun Nov 23 14:00:23 2008
@@ -1,6 +1,6 @@
---
name: Sub-Uplevel
-version: 0.1901
+version: 0.2002
author:
- 'David A. Golden <dagolden at cpan.org>'
abstract: apparently run a function in a higher stack frame
@@ -8,7 +8,7 @@
resources:
license: http://dev.perl.org/licenses/
requires:
- Exporter: 0
+ perl: 5.006
build_requires:
Carp: 0
Test::More: 0.47
@@ -17,7 +17,7 @@
file: lib/Sub/Uplevel.pm
Sub::Uplevel:
file: lib/Sub/Uplevel.pm
- version: 0.1901
+ version: 0.2002
generated_by: Module::Build version 0.280801
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
Modified: branches/upstream/libsub-uplevel-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/Makefile.PL?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/Makefile.PL (original)
+++ branches/upstream/libsub-uplevel-perl/current/Makefile.PL Sun Nov 23 14:00:23 2008
@@ -1,4 +1,5 @@
# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
+require 5.006;
use ExtUtils::MakeMaker;
WriteMakefile
(
@@ -9,7 +10,6 @@
'VERSION_FROM' => 'lib/Sub/Uplevel.pm',
'PREREQ_PM' => {
'Test::More' => '0.47',
- 'Exporter' => 0,
'Carp' => 0
}
)
Modified: branches/upstream/libsub-uplevel-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/README?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/README (original)
+++ branches/upstream/libsub-uplevel-perl/current/README Sun Nov 23 14:00:23 2008
@@ -2,7 +2,7 @@
Sub::Uplevel - apparently run a function in a higher stack frame
VERSION
- This documentation describes version 0.1901
+ This documentation describes version 0.2002
SYNOPSIS
use Sub::Uplevel;
@@ -52,6 +52,9 @@
return @out;
}
+ "uplevel" will issue a warning if $num_frames is more than the
+ current call stack depth.
+
EXAMPLE
The main reason I wrote this module is so I could write wrappers around
functions and they wouldn't be aware they've been wrapped.
@@ -80,6 +83,8 @@
However, if you are routinely using multiple modules that override
CORE::GLOBAL::caller, you are probably asking for trouble.
+ As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater.
+
HISTORY
Those who do not learn from HISTORY are doomed to repeat it.
Modified: branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pm?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pm (original)
+++ branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pm Sun Nov 23 14:00:23 2008
@@ -1,8 +1,22 @@
package Sub::Uplevel;
+use 5.006;
use strict;
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.1901';
+our $VERSION = '0.2002';
+$VERSION = eval $VERSION;
+
+sub import {
+ no strict 'refs';
+ my ($class, @args) = @_;
+ for my $fcn ( @args ) {
+ if ( $fcn ne 'uplevel' ) {
+ die qq{"$fcn" is not exported by the $class module\n}
+ }
+ }
+ my $caller = caller(0);
+ *{"$caller\::uplevel"} = \&uplevel;
+ return;
+}
# We must override *CORE::GLOBAL::caller if it hasn't already been
# overridden or else Perl won't see our local override later.
@@ -11,9 +25,6 @@
*CORE::GLOBAL::caller = \&_normal_caller;
}
-require Exporter;
- at ISA = qw(Exporter);
- at EXPORT = qw(uplevel);
=head1 NAME
@@ -79,17 +90,26 @@
return @out;
}
+C<uplevel> will issue a warning if C<$num_frames> is more than the current call
+stack depth.
=cut
-use vars qw/@Up_Frames $Caller_Proxy/;
# @Up_Frames -- uplevel stack
# $Caller_Proxy -- whatever caller() override was in effect before uplevel
+our (@Up_Frames, $Caller_Proxy);
+
+sub _apparent_stack_height {
+ my $height = 1; # start above this function
+ while ( 1 ) {
+ last if ! defined scalar $Caller_Proxy->($height);
+ $height++;
+ }
+ return $height - 1; # subtract 1 for this function
+}
sub uplevel {
my($num_frames, $func, @args) = @_;
-
- local @Up_Frames = ($num_frames, @Up_Frames );
# backwards compatible version of "no warnings 'redefine'"
my $old_W = $^W;
@@ -103,6 +123,13 @@
# restore old warnings state
$^W = $old_W;
+ if ( $num_frames >= _apparent_stack_height() ) {
+ require Carp;
+ Carp::carp("uplevel $num_frames is more than the caller stack");
+ }
+
+ local @Up_Frames = ($num_frames, @Up_Frames );
+
return $func->(@args);
}
@@ -263,6 +290,8 @@
However, if you are routinely using multiple modules that override
CORE::GLOBAL::caller, you are probably asking for trouble.
+As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater.
+
=head1 HISTORY
Those who do not learn from HISTORY are doomed to repeat it.
@@ -297,5 +326,4 @@
=cut
-
1;
Modified: branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pod?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pod (original)
+++ branches/upstream/libsub-uplevel-perl/current/lib/Sub/Uplevel.pod Sun Nov 23 14:00:23 2008
@@ -8,7 +8,7 @@
=head1 VERSION
-This documentation describes version 0.1901
+This documentation describes version 0.2002
=head1 SYNOPSIS
@@ -63,6 +63,8 @@
return @out;
}
+C<uplevel> will issue a warning if C<$num_frames> is more than the current call
+stack depth.
=begin _private
@@ -145,6 +147,8 @@
However, if you are routinely using multiple modules that override
CORE::GLOBAL::caller, you are probably asking for trouble.
+As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater.
+
=head1 HISTORY
Those who do not learn from HISTORY are doomed to repeat it.
Modified: branches/upstream/libsub-uplevel-perl/current/t/02_uplevel.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/t/02_uplevel.t?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/t/02_uplevel.t (original)
+++ branches/upstream/libsub-uplevel-perl/current/t/02_uplevel.t Sun Nov 23 14:00:23 2008
@@ -2,7 +2,7 @@
use lib qw(t/lib);
use strict;
-use Test::More tests => 22;
+use Test::More tests => 23;
BEGIN { use_ok('Sub::Uplevel'); }
can_ok('Sub::Uplevel', 'uplevel');
@@ -68,7 +68,7 @@
sub wrap_croak {
# line 68
- uplevel(1, \&try_croak);
+ uplevel(shift, \&try_croak);
}
@@ -76,13 +76,22 @@
# in the stack. This test used to be 'require 0' for <= 5.006, but
# it broke on 5.005_05 test release, so we'll just take either
# line 72
-eval { wrap_croak() };
+eval { wrap_croak(1) };
my $croak_regex = quotemeta( <<"CARP" );
Now we can fool croak! at $0 line 64
- main::wrap_croak() called at $0 line 72
+ main::wrap_croak(1) called at $0 line 72
CARP
$croak_regex .= '\t(require 0|eval \{\.\.\.\})'
. quotemeta( " called at $0 line 72" );
+like( $@, "/$croak_regex/", 'croak() fooled');
+
+# Try to wrap higher -- this may have been a problem that was exposed on
+# Test Exception
+# line 75
+eval { wrap_croak(2) };
+$croak_regex = quotemeta( <<"CARP" );
+Now we can fool croak! at $0 line 64
+CARP
like( $@, "/$croak_regex/", 'croak() fooled');
#line 79
Modified: branches/upstream/libsub-uplevel-perl/current/t/04_honor_later_override.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/t/04_honor_later_override.t?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/t/04_honor_later_override.t (original)
+++ branches/upstream/libsub-uplevel-perl/current/t/04_honor_later_override.t Sun Nov 23 14:00:23 2008
@@ -14,7 +14,7 @@
sub _reverse_caller(;$) {
my $height = $_[0];
my @caller = CORE::caller(++$height);
- $caller[0] = reverse $caller[0];
+ $caller[0] = defined $caller[0] ? reverse $caller[0] : undef;
if( wantarray and !@_ ) {
return @caller[0..2];
}
@@ -68,8 +68,8 @@
# Test for reversed package name both inside and outside an uplevel call
#--------------------------------------------------------------------------#
-is( scalar caller(), '',
- "caller from main package is empty string"
+is( scalar caller(), undef,
+ "caller from main package is undef"
);
is( test_caller(), reverse("main"),
Modified: branches/upstream/libsub-uplevel-perl/current/t/05_honor_prior_override.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/t/05_honor_prior_override.t?rev=27207&op=diff
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/t/05_honor_prior_override.t (original)
+++ branches/upstream/libsub-uplevel-perl/current/t/05_honor_prior_override.t Sun Nov 23 14:00:23 2008
@@ -2,19 +2,20 @@
use lib qw(t/lib);
use strict;
-use Test::More tests => 7;
+use Test::More tests => 10;
# 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
+# define a custom caller function that increments a counter
#--------------------------------------------------------------------------#
-sub _reverse_caller(;$) {
+my $caller_counter = 0;
+sub _count_caller(;$) {
+ $caller_counter++;
my $height = $_[0];
my @caller = CORE::caller(++$height);
- $caller[0] = reverse $caller[0];
if( wantarray and !@_ ) {
return @caller[0..2];
}
@@ -39,17 +40,17 @@
# old style no warnings 'redefine'
my $old_W = $^W;
$^W = 0;
- *CORE::GLOBAL::caller = \&_reverse_caller;
+ *CORE::GLOBAL::caller = \&_count_caller;
$^W = $old_W;
}
- is( *CORE::GLOBAL::caller{CODE}, \&_reverse_caller,
+ is( *CORE::GLOBAL::caller{CODE}, \&_count_caller,
"added custom caller override"
);
use_ok('Sub::Uplevel');
- is( *CORE::GLOBAL::caller{CODE}, \&_reverse_caller,
+ is( *CORE::GLOBAL::caller{CODE}, \&_count_caller,
"custom caller override still in place"
);
@@ -70,15 +71,23 @@
# Test for reversed package name both inside and outside an uplevel call
#--------------------------------------------------------------------------#
-is( scalar caller(), '',
- "caller from main package is empty string"
+my $old_caller_counter;
+
+$old_caller_counter = $caller_counter;
+is( scalar caller(), undef,
+ "caller from main package is undef"
);
+ok( $caller_counter > $old_caller_counter, "custom caller() was used" );
-is( test_caller(), reverse("main"),
- "caller from subroutine calls custom routine"
+$old_caller_counter = $caller_counter;
+is( test_caller(), "main",
+ "caller from subroutine is main"
);
+ok( $caller_counter > $old_caller_counter, "custom caller() was used" );
-is( test_caller_w_uplevel(), reverse("main"),
- "caller from uplevel subroutine calls custom routine"
+$old_caller_counter = $caller_counter;
+is( test_caller_w_uplevel(), "main",
+ "caller from uplevel subroutine is main"
);
+ok( $caller_counter > $old_caller_counter, "custom caller() was used" );
Added: branches/upstream/libsub-uplevel-perl/current/t/07_uplevel_too_high.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsub-uplevel-perl/current/t/07_uplevel_too_high.t?rev=27207&op=file
==============================================================================
--- branches/upstream/libsub-uplevel-perl/current/t/07_uplevel_too_high.t (added)
+++ branches/upstream/libsub-uplevel-perl/current/t/07_uplevel_too_high.t Sun Nov 23 14:00:23 2008
@@ -1,0 +1,27 @@
+use lib qw(t/lib);
+use strict;
+use Test::More tests => 5;
+
+BEGIN { use_ok('Sub::Uplevel'); }
+
+sub show_caller {
+ return scalar caller;
+}
+
+sub wrap_show_caller {
+ my $uplevel = shift;
+ return uplevel $uplevel, \&show_caller;
+}
+
+my $warning = '';
+local $SIG{__WARN__} = sub { $warning = shift };
+
+my $caller = wrap_show_caller(1);
+is($caller, 'main', "wrapper returned correct caller");
+is( $warning, '', "don't warn if ordinary uplevel" );
+
+$warning = '';
+$caller = wrap_show_caller(2);
+my $file = __FILE__;
+is($caller, undef, "wrapper returned correct caller");
+like( $warning, qr/uplevel 2 is more than the caller stack/, "warn if too much uplevel" );
More information about the Pkg-perl-cvs-commits
mailing list