summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/perl/lib/NEXT
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/usr.bin/perl/lib/NEXT')
-rw-r--r--gnu/usr.bin/perl/lib/NEXT/Changes39
-rw-r--r--gnu/usr.bin/perl/lib/NEXT/README80
-rw-r--r--gnu/usr.bin/perl/lib/NEXT/t/actual.t37
-rw-r--r--gnu/usr.bin/perl/lib/NEXT/t/actuns.t37
-rw-r--r--gnu/usr.bin/perl/lib/NEXT/t/next.t106
-rw-r--r--gnu/usr.bin/perl/lib/NEXT/t/unseen.t36
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;