ext/NEXT/t/unseen.t

   1 use Test::More tests => 7;
   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 { ::ok(++$order==1,"test A"); $_[0]->NEXT::UNSEEN::test; 1}
  17
  18 package B;
  19 @ISA = qw/D C/;
  20 sub test { ::ok(++$order==2,"test B"); $_[0]->NEXT::UNSEEN::test; 1}
  21
  22 package C;
  23 @ISA = qw/D/;
  24 sub test { ::ok(++$order==4,"test C"); $_[0]->NEXT::UNSEEN::test; 1}
  25
  26 package D;
  27
  28 sub test { ::ok(++$order==3,"test D"); $_[0]->NEXT::UNSEEN::test; 1}
  29
  30 package main;
  31
  32 my $foo = {};
  33
  34 bless($foo,"A");
  35
  36 eval{ $foo->test }
  37         ? pass("Correctly survives after C")
  38         : fail("Shouldn't die on missing ancestor");
  39
  40 package Diamond::Base;
  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 }
  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;