lib/NEXT/t/actual.t

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