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