Upgrade NEXT to 0.64.

diff --git a/lib/NEXT.pm b/lib/NEXT.pm
index f36fb7d..1e59280 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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.");