diff options
Diffstat (limited to 'gnu/usr.bin/perl/lib/NEXT')
| -rw-r--r-- | gnu/usr.bin/perl/lib/NEXT/Changes | 39 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/NEXT/README | 80 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/NEXT/t/actual.t | 37 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/NEXT/t/actuns.t | 37 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/NEXT/t/next.t | 106 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/NEXT/t/unseen.t | 36 |
6 files changed, 335 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/lib/NEXT/Changes b/gnu/usr.bin/perl/lib/NEXT/Changes new file mode 100644 index 00000000000..f6f7bff1b2f --- /dev/null +++ b/gnu/usr.bin/perl/lib/NEXT/Changes @@ -0,0 +1,39 @@ +Revision history for Perl extension NEXT.pm. + +0.01 Tue Apr 10 18:27:00 EST 2001 + + - original version + + +0.01 Thu Apr 12 17:06:49 2001 + + - Documented the difference between NEXT and SUPER (thanks Ken) + + + +0.01 Thu Apr 12 17:15:42 2001 + + + +0.02 Mon Sep 3 07:52:27 2001 + + - Fixed setting of $AUTOLOAD in NEXT'd AUTOLOADS (thanks Leonid) + + - Changed licence for inclusion in core distribution + + +0.50 Fri Nov 16 11:20:40 2001 + + - 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 diff --git a/gnu/usr.bin/perl/lib/NEXT/README b/gnu/usr.bin/perl/lib/NEXT/README new file mode 100644 index 00000000000..ad750bcdb47 --- /dev/null +++ b/gnu/usr.bin/perl/lib/NEXT/README @@ -0,0 +1,80 @@ +============================================================================== + Release of version 0.50 of NEXT +============================================================================== + + +NAME + + NEXT - Pseudo class for method redispatch + + +DESCRIPTION + + NEXT.pm adds a pseudoclass named C<NEXT> to any program that + uses it. If a method C<m> calls C<$self->NEXT::m()>, the call to + C<m> is redispatched as if the calling method had not originally + been found. + + In other words, a call to C<$self->NEXT::m()> resumes the + depth-first, left-to-right search of parent classes that + resulted in the original call to C<m>. + + Note that this is not the same thing as C<$self->SUPER::m()>, which + begins a new dispatch that is restricted to searching the ancestors + of the current class. C<$self->NEXT::m()> can backtrack past + 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 + C<AUTOLOAD>'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<AUTOLOAD> + (above it, or to its left) might do better. + + The module also allows you to specify that multiply inherited + methods should only be redispatched once, and what should + happen if no redispatch is possible. + + +AUTHOR + + Damian Conway (damian@conway.org) + + +COPYRIGHT + + Copyright (c) 2000-2001, Damian Conway. All Rights Reserved. + This module is free software. It may be used, redistributed + and/or modified under the same terms as Perl itself. + + +============================================================================== + +CHANGES IN VERSION 0.50 + + + - 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 + + +============================================================================== + +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/gnu/usr.bin/perl/lib/NEXT/t/actual.t b/gnu/usr.bin/perl/lib/NEXT/t/actual.t new file mode 100644 index 00000000000..e45184052b0 --- /dev/null +++ b/gnu/usr.bin/perl/lib/NEXT/t/actual.t @@ -0,0 +1,37 @@ +BEGIN { + if ($ENV{PERL_CORE}) { + chdir('t') if -d 't'; + @INC = qw(../lib); + } +} + +BEGIN { print "1..9\n"; } +use NEXT; + +my $count=1; + +package A; +@ISA = qw/B C D/; + +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::ACTUAL::test;} + +package B; +@ISA = qw/C D/; +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::ACTUAL::test;} + +package C; +@ISA = qw/D/; +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::ACTUAL::test;} + +package D; + +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::ACTUAL::test;} + +package main; + +my $foo = {}; + +bless($foo,"A"); + +eval { $foo->test } and print "not "; +print "ok 9\n"; diff --git a/gnu/usr.bin/perl/lib/NEXT/t/actuns.t b/gnu/usr.bin/perl/lib/NEXT/t/actuns.t new file mode 100644 index 00000000000..3795681bc2c --- /dev/null +++ b/gnu/usr.bin/perl/lib/NEXT/t/actuns.t @@ -0,0 +1,37 @@ +BEGIN { + if ($ENV{PERL_CORE}) { + chdir('t') if -d 't'; + @INC = qw(../lib); + } +} + +BEGIN { print "1..5\n"; } +use NEXT; + +my $count=1; + +package A; +@ISA = qw/B C D/; + +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::UNSEEN::ACTUAL::test;} + +package B; +@ISA = qw/C D/; +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::ACTUAL::UNSEEN::test;} + +package C; +@ISA = qw/D/; +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::UNSEEN::ACTUAL::test;} + +package D; + +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::ACTUAL::UNSEEN::test;} + +package main; + +my $foo = {}; + +bless($foo,"A"); + +eval { $foo->test } and print "not "; +print "ok 5\n"; diff --git a/gnu/usr.bin/perl/lib/NEXT/t/next.t b/gnu/usr.bin/perl/lib/NEXT/t/next.t new file mode 100644 index 00000000000..8cc493f3186 --- /dev/null +++ b/gnu/usr.bin/perl/lib/NEXT/t/next.t @@ -0,0 +1,106 @@ +BEGIN { + if ($ENV{PERL_CORE}) { + chdir('t') if -d 't'; + @INC = qw(../lib); + } +} + +BEGIN { print "1..25\n"; } + +use NEXT; + +print "ok 1\n"; + +package A; +sub A::method { return ( 3, $_[0]->NEXT::method() ) } +sub A::DESTROY { $_[0]->NEXT::DESTROY() } + +package B; +use base qw( A ); +sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() ) + if $AUTOLOAD =~ /.*(missing_method|secondary)/ } +sub B::DESTROY { $_[0]->NEXT::DESTROY() } + +package C; +sub C::DESTROY { print "ok 23\n"; $_[0]->NEXT::DESTROY() } + +package D; +@D::ISA = qw( B C E ); +sub D::method { return ( 2, $_[0]->NEXT::method() ) } +sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) } +sub D::DESTROY { print "ok 22\n"; $_[0]->NEXT::DESTROY() } +sub D::oops { $_[0]->NEXT::method() } +sub D::secondary { return ( 17, 18, map { $_+10 } $_[0]->NEXT::secondary() ) } + +package E; +@E::ISA = qw( F G ); +sub E::method { return ( 4, $_[0]->NEXT::method(), $_[0]->NEXT::method() ) } +sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() ) + if $AUTOLOAD =~ /.*(missing_method|secondary)/ } +sub E::DESTROY { print "ok 24\n"; $_[0]->NEXT::DESTROY() } + +package F; +sub F::method { return ( 5 ) } +sub F::AUTOLOAD { return ( 11 ) if $AUTOLOAD =~ /.*(missing_method|secondary)/ } +sub F::DESTROY { print "ok 25\n" } + +package G; +sub G::method { return ( 6 ) } +sub G::AUTOLOAD { print "not "; return } +sub G::DESTROY { print "not ok 21"; return } + +package main; + +my $obj = bless {}, "D"; + +my @vals; + +# TEST NORMAL REDISPATCH (ok 2..6) +@vals = $obj->method(); +print map "ok $_\n", @vals; + +# RETEST NORMAL REDISPATCH SHOULD BE THE SAME (ok 7) +@vals = $obj->method(); +print "not " unless join("", @vals) == "23456"; +print "ok 7\n"; + +# TEST AUTOLOAD REDISPATCH (ok 8..11) +@vals = $obj->missing_method(); +print map "ok $_\n", @vals; + +# NAMED METHOD CAN'T REDISPATCH TO NAMED METHOD OF DIFFERENT NAME (ok 12) +eval { $obj->oops() } && print "not "; +print "ok 12\n"; + +# AUTOLOAD'ED METHOD CAN'T REDISPATCH TO NAMED METHOD (ok 13) + +eval { + local *C::AUTOLOAD = sub { $_[0]->NEXT::method() }; + *C::AUTOLOAD = *C::AUTOLOAD; + eval { $obj->missing_method(); } && print "not "; +}; +print "ok 13\n"; + +# NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14) +eval { + *C::method = sub{ $_[0]->NEXT::AUTOLOAD() }; + *C::method = *C::method; + eval { $obj->method(); } && print "not "; +}; +print "ok 14\n"; + +# BASE CLASS METHODS ONLY REDISPATCHED WITHIN HIERARCHY (ok 15..16) +my $ob2 = bless {}, "B"; +@val = $ob2->method(); +print "not " unless @val==1 && $val[0]==3; +print "ok 15\n"; + +@val = $ob2->missing_method(); +print "not " unless @val==1 && $val[0]==9; +print "ok 16\n"; + +# TEST SECONDARY AUTOLOAD REDISPATCH (ok 17..21) +@vals = $obj->secondary(); +print map "ok $_\n", @vals; + +# CAN REDISPATCH DESTRUCTORS (ok 22..25) diff --git a/gnu/usr.bin/perl/lib/NEXT/t/unseen.t b/gnu/usr.bin/perl/lib/NEXT/t/unseen.t new file mode 100644 index 00000000000..af8d1f7612d --- /dev/null +++ b/gnu/usr.bin/perl/lib/NEXT/t/unseen.t @@ -0,0 +1,36 @@ +BEGIN { + if ($ENV{PERL_CORE}) { + chdir('t') if -d 't'; + @INC = qw(../lib); + } +} + +BEGIN { print "1..4\n"; } +use NEXT; + +my $count=1; + +package A; +@ISA = qw/B C D/; + +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::UNSEEN::test;} + +package B; +@ISA = qw/C D/; +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::UNSEEN::test;} + +package C; +@ISA = qw/D/; +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::UNSEEN::test;} + +package D; + +sub test { print "ok ", $count++, "\n"; $_[0]->NEXT::UNSEEN::test;} + +package main; + +my $foo = {}; + +bless($foo,"A"); + +$foo->test; |