From: Jarkko Hietaniemi Date: Wed, 30 Jul 2003 20:24:49 +0000 (+0000) Subject: Upgrade to NEXT 0.52. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=52138ef3a06f8cb332cb62ae77832a62a0223d75;p=p5sagit%2Fp5-mst-13.2.git Upgrade to NEXT 0.52. p4raw-id: //depot/perl@20362 --- diff --git a/lib/NEXT.pm b/lib/NEXT.pm index 3d90696..04dd8de 100644 --- a/lib/NEXT.pm +++ b/lib/NEXT.pm @@ -1,9 +1,9 @@ package NEXT; -$VERSION = '0.51'; +$VERSION = '0.52'; use Carp; use strict; -sub ancestors +sub NEXT::ELSEWHERE::ancestors { my @inlist = shift; my @outlist = (); @@ -32,7 +32,8 @@ sub AUTOLOAD unless ($NEXT::NEXT{$self,$wanted_method}) { my @forebears = - ancestors ref $self || $self, $wanted_class; + NEXT::ELSEWHERE::ancestors ref $self || $self, + $wanted_class; while (@forebears) { last if shift @forebears eq $caller_class } @@ -43,10 +44,10 @@ sub AUTOLOAD @{$NEXT::NEXT{$self,$wanted_method}} = map { (*{"${_}::AUTOLOAD"}{CODE}) ? "${_}::AUTOLOAD" : ()} @forebears unless @{$NEXT::NEXT{$self,$wanted_method}||[]}; - $NEXT::SEEN->{$self,*{$caller}{CODE}}++; + $NEXT::SEEN->{$self,*{$caller}{CODE}}++; } my $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}}; - while ($wanted_class =~ /^NEXT:.*:UNSEEN/ && defined $call_method + while ($wanted_class =~ /^NEXT:.*:(UNSEEN|DISTINCT):/ && defined $call_method && $NEXT::SEEN->{$self,$call_method}++) { $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}}; } @@ -56,7 +57,7 @@ sub AUTOLOAD croak qq(Can't locate object method "$wanted_method" ), qq(via package "$caller_class"); }; - return shift()->$call_method(@_) if ref $call_method eq 'CODE'; + return $self->$call_method(@_[1..$#_]) if ref $call_method eq 'CODE'; no strict 'refs'; ($wanted_method=${$caller_class."::AUTOLOAD"}) =~ s/.*::// if $wanted_method eq 'AUTOLOAD'; @@ -66,9 +67,13 @@ sub AUTOLOAD no strict 'vars'; package NEXT::UNSEEN; @ISA = 'NEXT'; +package NEXT::DISTINCT; @ISA = 'NEXT'; package NEXT::ACTUAL; @ISA = 'NEXT'; package NEXT::ACTUAL::UNSEEN; @ISA = 'NEXT'; +package NEXT::ACTUAL::DISTINCT; @ISA = 'NEXT'; package NEXT::UNSEEN::ACTUAL; @ISA = 'NEXT'; +package NEXT::DISTINCT::ACTUAL; @ISA = 'NEXT'; +package EVERY; @ISA = 'NEXT'; 1; @@ -240,30 +245,31 @@ call each method only once during a sequence of redispatches. To cover such cases, you can redispatch methods via: - $self->NEXT::UNSEEN::method(); + $self->NEXT::DISTINCT::method(); rather than: $self->NEXT::method(); -This causes the redispatcher to skip any classes in the hierarchy that it has -already visited in an earlier redispatch. So, for example, if the +This causes the redispatcher to only visit each distinct C method +once. That is, to skip any classes in the hierarchy that it has +already visited during redispatch. So, for example, if the previous example were rewritten: package A; - sub foo { print "called A::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called A::foo\n"; shift->NEXT::DISTINCT::foo() } package B; - sub foo { print "called B::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called B::foo\n"; shift->NEXT::DISTINCT::foo() } package C; @ISA = qw( A ); - sub foo { print "called C::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called C::foo\n"; shift->NEXT::DISTINCT::foo() } package D; @ISA = qw(A B); - sub foo { print "called D::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called D::foo\n"; shift->NEXT::DISTINCT::foo() } package E; @ISA = qw(C D); - sub foo { print "called E::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called E::foo\n"; shift->NEXT::DISTINCT::foo() } E->foo(); @@ -275,18 +281,21 @@ then it would print: called D::foo called B::foo -and omit the second call to C. +and omit the second call to C (since it would not be distinct +from the first call to C). Note that you can also use: - $self->NEXT::UNSEEN::ACTUAL::method(); + $self->NEXT::DISTINCT::ACTUAL::method(); or: - $self->NEXT::ACTUAL::UNSEEN::method(); + $self->NEXT::ACTUAL::DISTINCT::method(); to get both unique invocation I exception-on-failure. +Note that, for historical compatibility, you can also use +C instead of C. =head1 AUTHOR diff --git a/lib/NEXT/Changes b/lib/NEXT/Changes index f6f7bff..9bd1ebf 100644 --- a/lib/NEXT/Changes +++ b/lib/NEXT/Changes @@ -37,3 +37,19 @@ Revision history for Perl extension NEXT.pm. consistent with more useful SUPER:: behaviour - Corified tests + + +0.51 Tue Jul 29 23:09:48 2003 + + - Fixed NEXT::UNSEEN bug under diamond inheritance (thanks Dan + and Alan) + + - Moved &ancestors out of NEXT class in case anyone ever + calls NEXT::ancestors + + - Replaced UNSEEN with DISTINCT (but left UNSEEN operational + for backwards compatibility) + + +0.52 Wed Jul 30 21:06:59 2003 + diff --git a/lib/NEXT/README b/lib/NEXT/README index ad750bc..42fe91d 100644 --- a/lib/NEXT/README +++ b/lib/NEXT/README @@ -1,5 +1,5 @@ ============================================================================== - Release of version 0.50 of NEXT + Release of version 0.52 of NEXT ============================================================================== @@ -25,7 +25,7 @@ DESCRIPTION the current class -- to look for a suitable method in other ancestors of C<$self> -- whereas C<$self->SUPER::m()> cannot. - A particularly interesting use of redispatch is in + An particularly interesting use of redispatch is in C'ed methods. If such a method determines that it is not able to handle a particular call, it may choose to redispatch that call, in the hope that some other C @@ -50,22 +50,9 @@ COPYRIGHT ============================================================================== -CHANGES IN VERSION 0.50 +CHANGES IN VERSION 0.52 - - Added a $VERSION (oops!) - - - Fixed handling of diamond patterns (thanks Paul) - - - Added NEXT::ACTUAL to require existence of next method (thanks Paul) - - - Added NEXT::UNSEEN to avoid calling multiply inherited - methods twice (thanks Paul) - - - Re-fixed setting of $AUTOLOAD in NEXT'd AUTOLOADS to be - consistent with more useful SUPER:: behaviour - - - Corified tests ============================================================================== @@ -73,8 +60,5 @@ CHANGES IN VERSION 0.50 AVAILABILITY NEXT has been uploaded to the CPAN -and is also available from: - - http://www.csse.monash.edu.au/~damian/CPAN/NEXT.tar.gz ============================================================================== diff --git a/lib/NEXT/t/actuns.t b/lib/NEXT/t/actuns.t index 3795681..aca30c7 100644 --- a/lib/NEXT/t/actuns.t +++ b/lib/NEXT/t/actuns.t @@ -5,7 +5,7 @@ BEGIN { } } -BEGIN { print "1..5\n"; } +BEGIN { print "1..6\n"; } use NEXT; my $count=1; @@ -34,4 +34,3 @@ my $foo = {}; bless($foo,"A"); eval { $foo->test } and print "not "; -print "ok 5\n"; diff --git a/lib/NEXT/t/unseen.t b/lib/NEXT/t/unseen.t index ec24564..ddaab18 100644 --- a/lib/NEXT/t/unseen.t +++ b/lib/NEXT/t/unseen.t @@ -5,7 +5,7 @@ BEGIN { } } -BEGIN { print "1..5\n"; } +BEGIN { print "1..10\n"; } use NEXT; my $count=1;