From: Florian Ragwitz Date: Mon, 8 Jun 2009 12:57:15 +0000 (+0200) Subject: Upgrade NEXT to 0.64. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3c2847f4f8290362f8c36bb55d0e2df07f55d20c;p=p5sagit%2Fp5-mst-13.2.git Upgrade NEXT to 0.64. --- diff --git a/lib/NEXT.pm b/lib/NEXT.pm index f36fb7d..1e59280 100644 --- a/lib/NEXT.pm +++ b/lib/NEXT.pm @@ -1,5 +1,5 @@ package NEXT; -$VERSION = '0.63'; +$VERSION = '0.64'; use Carp; use strict; use overload (); @@ -42,8 +42,8 @@ sub NEXT::ELSEWHERE::buildAUTOLOAD my $caller = (caller($depth))[3]; my $wanted = $NEXT::AUTOLOAD || $autoload_name; undef $NEXT::AUTOLOAD; - my ($caller_class, $caller_method) = $caller =~ m{(.*)::(.*)}g; - my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g; + my ($caller_class, $caller_method) = do { $caller =~ m{(.*)::(.*)}g }; + my ($wanted_class, $wanted_method) = do { $wanted =~ m{(.*)::(.*)}g }; croak "Can't call $wanted from $caller" unless $caller_method eq $wanted_method; @@ -78,20 +78,20 @@ sub NEXT::ELSEWHERE::buildAUTOLOAD $NEXT::SEEN->{$key,*{$caller}{CODE}}++; } my $call_method = shift @{$NEXT::NEXT{$key,$wanted_method}}; - while ($wanted_class =~ /^NEXT\b.*\b(UNSEEN|DISTINCT)\b/ + while (do { $wanted_class =~ /^NEXT\b.*\b(UNSEEN|DISTINCT)\b/ } && defined $call_method && $NEXT::SEEN->{$key,$call_method}++) { $call_method = shift @{$NEXT::NEXT{$key,$wanted_method}}; } unless (defined $call_method) { - return unless $wanted_class =~ /^NEXT:.*:ACTUAL/; + return unless do { $wanted_class =~ /^NEXT:.*:ACTUAL/ }; (local $Carp::CarpLevel)++; croak qq(Can't locate object method "$wanted_method" ), qq(via package "$caller_class"); }; return $self->$call_method(@_[1..$#_]) if ref $call_method eq 'CODE'; no strict 'refs'; - ($wanted_method=${$caller_class."::AUTOLOAD"}) =~ s/.*::// + do { ($wanted_method=${$caller_class."::AUTOLOAD"}) =~ s/.*::// } if $wanted_method eq 'AUTOLOAD'; $$call_method = $caller_class."::NEXT::".$wanted_method; return $call_method->(@_); @@ -121,7 +121,7 @@ sub EVERY::ELSEWHERE::buildAUTOLOAD { my $caller = (caller($depth))[3]; my $wanted = $EVERY::AUTOLOAD || $autoload_name; undef $EVERY::AUTOLOAD; - my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g; + my ($wanted_class, $wanted_method) = do { $wanted =~ m{(.*)::(.*)}g }; my $key = ref($self) && overload::Overloaded($self) ? overload::StrVal($self) : $self; @@ -133,7 +133,7 @@ sub EVERY::ELSEWHERE::buildAUTOLOAD { my @forebears = NEXT::ELSEWHERE::ordered_ancestors ref $self || $self, $wanted_class; - @forebears = reverse @forebears if $wanted_class =~ /\bLAST\b/; + @forebears = reverse @forebears if do { $wanted_class =~ /\bLAST\b/ }; no strict 'refs'; my %seen; my @every = map { my $sub = "${_}::$wanted_method"; diff --git a/lib/NEXT/Changes b/lib/NEXT/Changes index 6888015..b691d25 100644 --- a/lib/NEXT/Changes +++ b/lib/NEXT/Changes @@ -1,5 +1,9 @@ Revision history for Perl extension NEXT.pm. +0.64 Mon Jun 8 14:36:00 2009 + - Fixed overwriting dynamically scoped regex vars (Norbert Buchmuller, + Closes RT#36956). + 0.63 Fri Apr 10 16:52:44 2009 - Specify plans for all tests (Jarkko Hietaniemi). Merged from blead perl (Florian Ragwitz). diff --git a/lib/NEXT/README b/lib/NEXT/README index a60aae0..af8b562 100644 --- a/lib/NEXT/README +++ b/lib/NEXT/README @@ -50,17 +50,6 @@ COPYRIGHT ============================================================================== -CHANGES IN VERSION 0.60 - - - - Re-re-re-fixed NEXT::UNSEEN bug under diamond inheritance - (Note to self: don't code whilst on vacation!) - - - Implemented and documented EVERY functionality - - -============================================================================== - AVAILABILITY NEXT has been uploaded to the CPAN diff --git a/lib/NEXT/t/dynamically_scoped_regex_vars.t b/lib/NEXT/t/dynamically_scoped_regex_vars.t new file mode 100644 index 0000000..2d209e0 --- /dev/null +++ b/lib/NEXT/t/dynamically_scoped_regex_vars.t @@ -0,0 +1,50 @@ +use Test::More tests => 7; + +BEGIN { + if ($ENV{PERL_CORE}) { + chdir('t') if -d 't'; + @INC = qw(../lib); + } +} + +BEGIN { use_ok('NEXT') }; + +package A; +use base qw(B); +use NEXT; +sub test_next { shift->NEXT::test_next(@_); } +sub test_next_distinct { shift->NEXT::DISTINCT::test_next_distinct(@_); } +sub test_next_actual { shift->NEXT::ACTUAL::test_next_actual(@_); } +sub test_next_actual_distinct { shift->NEXT::ACTUAL::DISTINCT::test_next_actual_distinct(@_); } +sub test_every { shift->EVERY::test_every(@_); } +sub test_every_last { shift->EVERY::LAST::test_every_last(@_); } + +package B; +sub test_next { $_[1]; } +sub test_next_distinct { $_[1]; } +sub test_next_actual { $_[1]; } +sub test_next_actual_distinct { $_[1]; } +sub test_every { $_[1]; } +sub test_every_last { $_[1]; } + +package main; + +my $foo = bless {}, 'A'; + +"42" =~ /(.*)/; +is($foo->test_next($&), $&, "The value of '\$&' was not overwritten in NEXT."); + +"42" =~ /(.*)/; +is($foo->test_next_distinct($&), $&, "The value of '\$&' was not overwritten in NEXT::DISTINCT."); + +"42" =~ /(.*)/; +is($foo->test_next_actual($&), $&, "The value of '\$&' was not overwritten in NEXT::ACTUAL."); + +"42" =~ /(.*)/; +is($foo->test_next_actual_distinct($&), $&, "The value of '\$&' was not overwritten in NEXT::ACTUAL::DISTINCT."); + +"42" =~ /(.*)/; +is($foo->test_every($&)->{'B::test_every'}, $&, "The value of '\$&' was not overwritten in EVERY."); + +"42" =~ /(.*)/; +is($foo->test_every_last($&)->{'B::test_every_last'}, $&, "The value of '\$&' was not overwritten in EVERY::LAST.");