Commit | Line | Data |
cd6c9654 |
1 | use Test::More tests => 7; |
bf5734d4 |
2 | |
13021a80 |
3 | BEGIN { |
4 | if ($ENV{PERL_CORE}) { |
5 | chdir('t') if -d 't'; |
6 | @INC = qw(../lib); |
7 | } |
8 | } |
9 | |
bf5734d4 |
10 | BEGIN { use_ok('NEXT') }; |
11 | my $order = 0; |
13021a80 |
12 | |
13 | package A; |
14 | @ISA = qw/B C D/; |
15 | |
bf5734d4 |
16 | sub test { ::ok(++$order==1,"test A"); $_[0]->NEXT::UNSEEN::test; 1} |
13021a80 |
17 | |
18 | package B; |
bf5734d4 |
19 | @ISA = qw/D C/; |
20 | sub test { ::ok(++$order==2,"test B"); $_[0]->NEXT::UNSEEN::test; 1} |
13021a80 |
21 | |
22 | package C; |
23 | @ISA = qw/D/; |
bf5734d4 |
24 | sub test { ::ok(++$order==4,"test C"); $_[0]->NEXT::UNSEEN::test; 1} |
13021a80 |
25 | |
26 | package D; |
27 | |
bf5734d4 |
28 | sub test { ::ok(++$order==3,"test D"); $_[0]->NEXT::UNSEEN::test; 1} |
13021a80 |
29 | |
30 | package main; |
31 | |
32 | my $foo = {}; |
33 | |
34 | bless($foo,"A"); |
35 | |
bf5734d4 |
36 | eval{ $foo->test } |
37 | ? pass("Correctly survives after C") |
38 | : fail("Shouldn't die on missing ancestor"); |
d36e5bff |
39 | |
40 | package Diamond::Base; |
bf5734d4 |
41 | my $seen; |
42 | sub test { |
43 | $seen++ ? ::fail("Can't visit inherited test twice") |
44 | : ::pass("First diamond is okay"); |
45 | shift->NEXT::UNSEEN::test; |
46 | } |
d36e5bff |
47 | |
48 | package Diamond::Left; @ISA = qw[Diamond::Base]; |
49 | package Diamond::Right; @ISA = qw[Diamond::Base]; |
50 | package Diamond::Top; @ISA = qw[Diamond::Left Diamond::Right]; |
51 | |
52 | package main; |
53 | |
54 | Diamond::Top->test; |