commit perl-Sub-Uplevel

Hello community, here is the log from the commit of package perl-Sub-Uplevel checked in at Mon Oct 8 12:28:23 CEST 2007. -------- --- perl-Sub-Uplevel/perl-Sub-Uplevel.changes 2007-06-14 18:10:33.000000000 +0200 +++ /mounts/work_src_done/STABLE/perl-Sub-Uplevel/perl-Sub-Uplevel.changes 2007-10-08 09:59:16.000000000 +0200 @@ -1,0 +2,9 @@ +Mon Oct 8 09:25:50 CEST 2007 - anicka@suse.cz + +- update to 0.16 + * Won't override any existing CORE::GLOBAL::caller when loaded + * Localize global caller() override to the scope of the uplevel() + call so it can play nicer with things like Contextual::Return + and Hook::LexWrap that also override caller() + +------------------------------------------------------------------- Old: ---- Sub-Uplevel-0.14.tar.bz2 New: ---- Sub-Uplevel-0.16.tar.bz2 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Sub-Uplevel.spec ++++++ --- /var/tmp/diff_new_pack.O14639/_old 2007-10-08 12:28:20.000000000 +0200 +++ /var/tmp/diff_new_pack.O14639/_new 2007-10-08 12:28:20.000000000 +0200 @@ -1,5 +1,5 @@ # -# spec file for package perl-Sub-Uplevel (Version 0.14) +# spec file for package perl-Sub-Uplevel (Version 0.16) # # Copyright (c) 2007 SUSE LINUX Products GmbH, Nuernberg, Germany. # This file and all modifications and additions to the pristine @@ -11,13 +11,13 @@ # norootforbuild Name: perl-Sub-Uplevel -Version: 0.14 +Version: 0.16 Release: 1 Requires: perl = %{perl_version} -Autoreqprov: on +AutoReqProv: on Group: Development/Libraries/Perl License: Artistic License -URL: http://cpan.org/modules/by-module/Sub/ +Url: http://cpan.org/modules/by-module/Sub/ Summary: Sub::Uplevel - apparently run a function in a higher stack frame Source: Sub-Uplevel-%{version}.tar.bz2 BuildRoot: %{_tmppath}/%{name}-%{version}-build @@ -61,7 +61,12 @@ %dir %{perl_vendorarch}/auto/Sub/ %{perl_vendorlib}/Sub/* %{perl_vendorarch}/auto/Sub/Uplevel/ - %changelog +* Mon Oct 08 2007 - anicka@suse.cz +- update to 0.16 + * Won't override any existing CORE::GLOBAL::caller when loaded + * Localize global caller() override to the scope of the uplevel() + call so it can play nicer with things like Contextual::Return + and Hook::LexWrap that also override caller() * Thu Jun 14 2007 - anicka@suse.cz - package created (version 0.14) ++++++ Sub-Uplevel-0.14.tar.bz2 -> Sub-Uplevel-0.16.tar.bz2 ++++++ diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Sub-Uplevel-0.14/Changes new/Sub-Uplevel-0.16/Changes --- old/Sub-Uplevel-0.14/Changes 2006-11-06 06:19:38.000000000 +0100 +++ new/Sub-Uplevel-0.16/Changes 2007-07-30 15:57:03.000000000 +0200 @@ -1,5 +1,14 @@ Changes for Sub::Uplevel +0.16 Mon Jul 30 09:54:41 EDT 2007 + - release version of 0.15_01 changes + +0.15_01 Thu Jul 5 22:54:08 EDT 2007 + - Won't override any existing CORE::GLOBAL::caller when loaded + - Localize global caller() override to the scope of the uplevel() call + so it can play nicer with things like Contextual::Return and + Hook::LexWrap that also override caller() + 0.14 Sun Nov 5 23:38:46 EST 2006 - fixed t/99_pod_coverage.t bug - added examples directory diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Sub-Uplevel-0.14/lib/Sub/Uplevel.pm new/Sub-Uplevel-0.16/lib/Sub/Uplevel.pm --- old/Sub-Uplevel-0.14/lib/Sub/Uplevel.pm 2006-11-06 06:19:38.000000000 +0100 +++ new/Sub-Uplevel-0.16/lib/Sub/Uplevel.pm 2007-07-30 15:57:03.000000000 +0200 @@ -4,10 +4,14 @@ use strict; use vars qw($VERSION @ISA @EXPORT); -$VERSION = "0.14"; +$VERSION = "0.16"; -# We have to do this so the CORE::GLOBAL versions override the builtins -_setup_CORE_GLOBAL(); +# We must override *CORE::GLOBAL::caller if it hasn't already been +# overridden or else Perl won't see our local override later. + +if ( not defined *CORE::GLOBAL::caller{CODE} ) { + *CORE::GLOBAL::caller = \&_normal_caller; +} require Exporter; @ISA = qw(Exporter); @@ -73,24 +77,40 @@ =cut our @Up_Frames; # uplevel stack +our $Caller_Proxy; # whatever caller() override was in effect before uplevel sub uplevel { my($num_frames, $func, @args) = @_; local @Up_Frames = ($num_frames, @Up_Frames ); + + no warnings 'redefine'; + # Update the caller proxy if the uplevel override isn't in effect + local $Caller_Proxy = *CORE::GLOBAL::caller{CODE} + if *CORE::GLOBAL::caller{CODE} != \&_uplevel_caller; + 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'; - - *CORE::GLOBAL::caller = sub(;$) { - my $height = $_[0] || 0; +sub _uplevel_caller (;$) { + 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 (proxy caller function) + # to skip this function's caller + return $Caller_Proxy->( $height + 1 ) if ! @Up_Frames; =begin _private @@ -142,36 +162,39 @@ =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 - - 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++; - } + # 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. + # We *must* use CORE::caller here since we need the real stack not what + # some other override says the stack looks like, just in case that other + # override breaks things in some horrible way + + 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); - - if( wantarray ) { - if( !@_ ) { - @caller = @caller[0..2]; - } - return @caller; - } - else { - return $caller[0]; + # For returning values, we pass through the call to the proxy caller + # function, just at a higher stack level + my @caller = $Caller_Proxy->($height + $adjust + 1); + + if( wantarray ) { + if( !@_ ) { + @caller = @caller[0..2]; } - }; # sub - + return @caller; + } + else { + return $caller[0]; + } } =back @@ -196,15 +219,16 @@ =head1 BUGS and CAVEATS -Sub::Uplevel must be used as early as possible in your program's -compilation. - 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). +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 +each uplevel call) such as from Contextual::Return or Hook::LexWrap. +However, if you are routinely using multiple modules that override +CORE::GLOBAL::caller, you are probably asking for trouble. =head1 HISTORY @@ -213,12 +237,10 @@ The lesson here is simple: Don't sit next to a Tcl programmer at the dinner table. - =head1 THANKS Thanks to Brent Welch, Damian Conway and Robin Houston. - =head1 AUTHORS David A Golden E<lt>dagolden@cpan.orgE<gt> (current maintainer) @@ -227,14 +249,14 @@ =head1 LICENSE -Copyright by Michael G Schwern, David A Golden +Original code Copyright (c) 2001 to 2007 by Michael G Schwern. +Additional code Copyright (c) 2006 to 2007 by David A Golden. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See http://www.perl.com/perl/misc/Artistic.html - =head1 SEE ALSO PadWalker (for the similar idea with lexicals), Hook::LexWrap, diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Sub-Uplevel-0.14/MANIFEST new/Sub-Uplevel-0.16/MANIFEST --- old/Sub-Uplevel-0.14/MANIFEST 2006-11-06 06:19:38.000000000 +0100 +++ new/Sub-Uplevel-0.16/MANIFEST 2007-07-30 15:57:03.000000000 +0200 @@ -10,6 +10,8 @@ t/01_die_check.t t/02_uplevel.t t/03_nested_uplevels.t +t/04_honor_later_override.t +t/05_honor_prior_override.t t/98_pod.t t/99_pod_coverage.t t/lib/Foo.pm diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Sub-Uplevel-0.14/META.yml new/Sub-Uplevel-0.16/META.yml --- old/Sub-Uplevel-0.14/META.yml 2006-11-06 06:19:38.000000000 +0100 +++ new/Sub-Uplevel-0.16/META.yml 2007-07-30 15:57:03.000000000 +0200 @@ -1,6 +1,6 @@ --- name: Sub-Uplevel -version: 0.14 +version: 0.16 author: - 'David A. Golden ' abstract: apparently run a function in a higher stack frame @@ -13,7 +13,7 @@ provides: Sub::Uplevel: file: lib/Sub/Uplevel.pm - version: 0.14 + version: 0.16 generated_by: Module::Build version 0.2805 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Sub-Uplevel-0.14/README new/Sub-Uplevel-0.16/README --- old/Sub-Uplevel-0.14/README 2006-11-06 06:19:38.000000000 +0100 +++ new/Sub-Uplevel-0.16/README 2007-07-30 15:57:03.000000000 +0200 @@ -66,14 +66,16 @@ If this code frightens you you should not use this module. BUGS and CAVEATS - Sub::Uplevel must be used as early as possible in your program's - compilation. - 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). + 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 + each uplevel call) such as from Contextual::Return or Hook::LexWrap. + + However, if you are routinely using multiple modules that override + CORE::GLOBAL::caller, you are probably asking for trouble. HISTORY Those who do not learn from HISTORY are doomed to repeat it. @@ -90,7 +92,8 @@ Michael G Schwern (original author) LICENSE - Copyright by Michael G Schwern, David A Golden + Original code Copyright (c) 2001 to 2007 by Michael G Schwern. + Additional code Copyright (c) 2006 to 2007 by David A Golden. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Sub-Uplevel-0.14/t/02_uplevel.t new/Sub-Uplevel-0.16/t/02_uplevel.t --- old/Sub-Uplevel-0.14/t/02_uplevel.t 2006-11-06 06:19:38.000000000 +0100 +++ new/Sub-Uplevel-0.16/t/02_uplevel.t 2007-07-30 15:57:03.000000000 +0200 @@ -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()' ); diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Sub-Uplevel-0.14/t/04_honor_later_override.t new/Sub-Uplevel-0.16/t/04_honor_later_override.t --- old/Sub-Uplevel-0.14/t/04_honor_later_override.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Sub-Uplevel-0.16/t/04_honor_later_override.t 2007-07-30 15:57:03.000000000 +0200 @@ -0,0 +1,79 @@ +#!/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 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] = reverse $caller[0]; + 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" + ); + + no warnings 'redefine'; + + *CORE::GLOBAL::caller = \&_reverse_caller; + +} + +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(), '', + "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" +); + diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Sub-Uplevel-0.14/t/05_honor_prior_override.t new/Sub-Uplevel-0.16/t/05_honor_prior_override.t --- old/Sub-Uplevel-0.14/t/05_honor_prior_override.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Sub-Uplevel-0.16/t/05_honor_prior_override.t 2007-07-30 15:57:03.000000000 +0200 @@ -0,0 +1,81 @@ +#!/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" + ); + + { + no warnings 'redefine'; + *CORE::GLOBAL::caller = \&_reverse_caller; + } + + 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" +); + ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Remember to have fun... --------------------------------------------------------------------- To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org For additional commands, e-mail: opensuse-commit+help@opensuse.org