xref: /openbsd-src/gnu/usr.bin/perl/cpan/NEXT/t/unseen.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c)
1use Test::More tests => 7;
2
3BEGIN { use_ok('NEXT') };
4my $order = 0;
5
6package A;
7@ISA = qw/B C D/;
8
9sub test { ::ok(++$order==1,"test A"); $_[0]->NEXT::UNSEEN::test; 1}
10
11package B;
12@ISA = qw/D C/;
13sub test { ::ok(++$order==2,"test B"); $_[0]->NEXT::UNSEEN::test; 1}
14
15package C;
16@ISA = qw/D/;
17sub test { ::ok(++$order==4,"test C"); $_[0]->NEXT::UNSEEN::test; 1}
18
19package D;
20
21sub test { ::ok(++$order==3,"test D"); $_[0]->NEXT::UNSEEN::test; 1}
22
23package main;
24
25my $foo = {};
26
27bless($foo,"A");
28
29eval{ $foo->test }
30	? pass("Correctly survives after C")
31	: fail("Shouldn't die on missing ancestor");
32
33package Diamond::Base;
34my $seen;
35sub test {
36	$seen++ ? ::fail("Can't visit inherited test twice")
37		: ::pass("First diamond is okay");
38	shift->NEXT::UNSEEN::test;
39}
40
41package Diamond::Left;  @ISA = qw[Diamond::Base];
42package Diamond::Right; @ISA = qw[Diamond::Base];
43package Diamond::Top;   @ISA = qw[Diamond::Left Diamond::Right];
44
45package main;
46
47Diamond::Top->test;
48