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