lib/NEXT/t/actuns.t

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