summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFlorian Ragwitz <rafl@debian.org>2009-06-08 14:57:15 +0200
committerFlorian Ragwitz <rafl@debian.org>2009-06-08 14:57:15 +0200
commit3c2847f4f8290362f8c36bb55d0e2df07f55d20c (patch)
tree73ed39339eaa425be6ab74f7c5d8641229cdc8ec
parentd7dfc388e04f41b8a0f5d8ef6e15ab3b79f483c8 (diff)
downloadperl-3c2847f4f8290362f8c36bb55d0e2df07f55d20c.tar.gz
Upgrade NEXT to 0.64.
-rw-r--r--lib/NEXT.pm16
-rw-r--r--lib/NEXT/Changes4
-rw-r--r--lib/NEXT/README11
-rw-r--r--lib/NEXT/t/dynamically_scoped_regex_vars.t50
4 files changed, 62 insertions, 19 deletions
diff --git a/lib/NEXT.pm b/lib/NEXT.pm
index f36fb7d516..1e59280241 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 6888015705..b691d25a28 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 a60aae0bc3..af8b5624ae 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 0000000000..2d209e0e4c
--- /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.");