1use Test::More tests => 10; 2 3BEGIN { 4 if ($ENV{PERL_CORE}) { 5 chdir('t') if -d 't'; 6 @INC = qw(../lib); 7 } 8} 9 10BEGIN { use_ok('NEXT') }; 11my $order = 0; 12 13package A; 14@ISA = qw/B C D/; 15 16sub test { ++$order; ::ok($order==1,"test A"); $_[0]->NEXT::ACTUAL::test;} 17 18package B; 19@ISA = qw/D C/; 20sub test { ++$order; ::ok($order==2,"test B"); $_[0]->NEXT::ACTUAL::test;} 21 22package C; 23@ISA = qw/D/; 24sub test { 25 ++$order; ::ok($order==4||$order==6,"test C"); 26 $_[0]->NEXT::ACTUAL::test; 27} 28 29package D; 30 31sub test { 32 ++$order; ::ok($order==3||$order==5||$order==7||$order==8,"test D"); 33 $_[0]->NEXT::ACTUAL::test; 34} 35 36package main; 37 38my $foo = {}; 39 40bless($foo,"A"); 41 42eval{ $foo->test } 43 ? fail("Didn't die on missing ancestor") 44 : pass("Correctly dies after full traversal"); 45