Re: [PATCH] NEXT.pm bug within overloaded stringification

Message-Id: <511B0A54-AB2D-4A65-A02E-E2E07C043EAB@univie.ac.at>

(a resend of <7BBCFD93-91CF-4656-A97F-ED5E749F7B2E@univie.ac.at>)

p4raw-id: //depot/perl@33416

diff --git a/MANIFEST b/MANIFEST
index 572dce9..7936533 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2306,6 +2306,7 @@ lib/NEXT/README                   NEXT
 lib/NEXT/t/actual.t            NEXT
 lib/NEXT/t/actuns.t            NEXT
 lib/NEXT/t/next.t              NEXT
+lib/NEXT/t/stringify.t NEXT
 lib/NEXT/t/unseen.t            NEXT
 lib/Object/Accessor.pm Object::Accessor
 lib/Object/Accessor/t/00_Object-Accessor.t     Object::Accessor tests

diff --git a/lib/NEXT.pm b/lib/NEXT.pm
index 51dec91..7bb9c75 100644 (file)
--- a/lib/NEXT.pm
+++ b/lib/NEXT.pm
@@ -2,6 +2,7 @@ package NEXT;
 $VERSION = '0.60_01';
 use Carp;
 use strict;
+use overload ();
 
 sub NEXT::ELSEWHERE::ancestors
 {
@@ -42,11 +43,13 @@ sub AUTOLOAD
        croak "Can't call $wanted from $caller"
                unless $caller_method eq $wanted_method;
 
-       local ($NEXT::NEXT{$self,$wanted_method}, $NEXT::SEEN) =
-             ($NEXT::NEXT{$self,$wanted_method}, $NEXT::SEEN);
+       my $key = ref $self && overload::Overloaded($self)
+           ? overload::StrVal($self) : $self;
 
+       local ($NEXT::NEXT{$key,$wanted_method}, $NEXT::SEEN) =
+             ($NEXT::NEXT{$key,$wanted_method}, $NEXT::SEEN);
 
-       unless ($NEXT::NEXT{$self,$wanted_method}) {
+       unless ($NEXT::NEXT{$key,$wanted_method}) {
                my @forebears =
                        NEXT::ELSEWHERE::ancestors ref $self || $self,
                                                   $wanted_class;
@@ -54,19 +57,19 @@ sub AUTOLOAD
                        last if shift @forebears eq $caller_class
                }
                no strict 'refs';
-               @{$NEXT::NEXT{$self,$wanted_method}} = 
+               @{$NEXT::NEXT{$key,$wanted_method}} = 
                        map { *{"${_}::$caller_method"}{CODE}||() } @forebears
                                unless $wanted_method eq 'AUTOLOAD';
-               @{$NEXT::NEXT{$self,$wanted_method}} = 
+               @{$NEXT::NEXT{$key,$wanted_method}} = 
                        map { (*{"${_}::AUTOLOAD"}{CODE}) ? "${_}::AUTOLOAD" : ()} @forebears
-                               unless @{$NEXT::NEXT{$self,$wanted_method}||[]};
-               $NEXT::SEEN->{$self,*{$caller}{CODE}}++;
+                               unless @{$NEXT::NEXT{$key,$wanted_method}||[]};
+               $NEXT::SEEN->{$key,*{$caller}{CODE}}++;
        }
-       my $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
+       my $call_method = shift @{$NEXT::NEXT{$key,$wanted_method}};
        while ($wanted_class =~ /^NEXT\b.*\b(UNSEEN|DISTINCT)\b/
               && defined $call_method
-              && $NEXT::SEEN->{$self,$call_method}++) {
-               $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
+              && $NEXT::SEEN->{$key,$call_method}++) {
+               $call_method = shift @{$NEXT::NEXT{$key,$wanted_method}};
        }
        unless (defined $call_method) {
                return unless $wanted_class =~ /^NEXT:.*:ACTUAL/;
@@ -103,11 +106,14 @@ sub AUTOLOAD
        undef $EVERY::AUTOLOAD;
        my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g;
 
-       local $NEXT::ALREADY_IN_EVERY{$self,$wanted_method} =
-             $NEXT::ALREADY_IN_EVERY{$self,$wanted_method};
+       my $key = ref($self) && overload::Overloaded($self)
+           ? overload::StrVal($self) : $self;
+
+       local $NEXT::ALREADY_IN_EVERY{$key,$wanted_method} =
+             $NEXT::ALREADY_IN_EVERY{$key,$wanted_method};
+
+       return if $NEXT::ALREADY_IN_EVERY{$key,$wanted_method}++;
 
-       return if $NEXT::ALREADY_IN_EVERY{$self,$wanted_method}++;
-       
        my @forebears = NEXT::ELSEWHERE::ordered_ancestors ref $self || $self,
                                                           $wanted_class;
        @forebears = reverse @forebears if $wanted_class =~ /\bLAST\b/;

diff --git a/lib/NEXT/t/stringify.t b/lib/NEXT/t/stringify.t
new file mode 100644 (file)
index 0000000..8d06890
--- /dev/null
+++ b/lib/NEXT/t/stringify.t
@@ -0,0 +1,35 @@
+use warnings;
+use strict;
+use Test::More tests => 2;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+        chdir('t') if -d 't';
+        @INC = qw(../lib);
+    }
+}
+
+BEGIN { use_ok('NEXT') };
+
+
+package Foo;
+
+use overload '""' => 'stringify';
+
+use constant BAR => (1..5);
+
+sub new { bless {}, shift }
+
+sub stringify {
+    my $self = shift;
+    my %result = $self->EVERY::LAST::BAR;
+    join '-' => @{ $result{'Foo::BAR'} };
+}
+
+
+
+package main;
+
+my $foo = Foo->new;
+is("$foo", '1-2-3-4-5', 'overloading stringification');
+