diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-18 04:17:15 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-18 04:17:15 +0000 |
commit | b695f709e8a342e35e482b0437eb6cdacdc58b6b (patch) | |
tree | 2d16192636e6ba806ff7a907f682c74f7705a920 /lib/NEXT | |
parent | d780cd7a0195e946e636d3ee546f6ef4f21d6acc (diff) | |
download | perl-b695f709e8a342e35e482b0437eb6cdacdc58b6b.tar.gz |
The Grand Trek: move the *.t files from t/ to lib/ and ext/.
No doubt I made some mistakes like missed some files or
misnamed some files. The naming rules were more or less:
(1) if the module is from CPAN, follows its ways, be it
t/*.t or test.pl.
(2) otherwise if there are multiple tests for a module
put them in a t/
(3) otherwise if there's only one test put it in Module.t
(4) helper files go to module/ (locale, strict, warnings)
(5) use longer filenames now that we can (but e.g. the
compat-0.6.t and the Text::Balanced test files still
were renamed to be more civil against the 8.3 people)
installperl was updated appropriately not to install the
*.t files or the help files from under lib.
TODO: some helper files still remain under t/ that could
follow their 'masters'. UPDATE: On second thoughts, why
should they. They can continue to live under t/lib, and
in fact the locale/strict/warnings helpers that were moved
could be moved back. This way the amount of non-installable
stuff under lib/ stays smaller.
p4raw-id: //depot/perl@10676
Diffstat (limited to 'lib/NEXT')
-rw-r--r-- | lib/NEXT/test.pl | 99 |
1 files changed, 99 insertions, 0 deletions
diff --git a/lib/NEXT/test.pl b/lib/NEXT/test.pl new file mode 100644 index 0000000000..6328fd170c --- /dev/null +++ b/lib/NEXT/test.pl @@ -0,0 +1,99 @@ +#! /usr/local/bin/perl -w + + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +BEGIN { print "1..20\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() ) } +sub B::DESTROY { $_[0]->NEXT::DESTROY() } + +package C; +sub C::DESTROY { print "ok 18\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 17\n"; $_[0]->NEXT::DESTROY() } +sub D::oops { $_[0]->NEXT::method() } + +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() ) } +sub E::DESTROY { print "ok 19\n"; $_[0]->NEXT::DESTROY() } + +package F; +sub F::method { return ( 5 ) } +sub F::AUTOLOAD { return ( 11 ) } +sub F::DESTROY { print "ok 20\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 q{ + package C; + sub AUTOLOAD { $_[0]->NEXT::method() }; +}; +eval { $obj->missing_method(); } && print "not "; +print "ok 13\n"; + +# NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14) +eval q{ + package C; + sub method { $_[0]->NEXT::AUTOLOAD() }; +}; +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"; + +# CAN REDISPATCH DESTRUCTORS (ok 17..20) |