stock perl 5.8.0 from CPAN

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;