From: Marcel Grünauer <marcel@codewerk.com>
Date: Mon, 3 Mar 2008 16:08:48 +0000 (+0100)
Subject: Re: [PATCH] NEXT.pm bug within overloaded stringification
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5dd54fb4257bccaa223fa7d57413e664e9bb3c2c;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
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');
+