t/mro/basic.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5
   6 require q(./test.pl); plan(tests => 8);
   7
   8 {
   9     package MRO_A;
  10     our @ISA = qw//;
  11     package MRO_B;
  12     our @ISA = qw//;
  13     package MRO_C;
  14     our @ISA = qw//;
  15     package MRO_D;
  16     our @ISA = qw/MRO_A MRO_B MRO_C/;
  17     package MRO_E;
  18     our @ISA = qw/MRO_A MRO_B MRO_C/;
  19     package MRO_F;
  20     our @ISA = qw/MRO_D MRO_E/;
  21 }
  22
  23 is(mro::get_mro('MRO_F'), 'dfs');
  24 ok(eq_array(
  25     mro::get_linear_isa('MRO_F'),
  26     [qw/MRO_F MRO_D MRO_A MRO_B MRO_C MRO_E/]
  27 ));
  28 mro::set_mro('MRO_F', 'c3');
  29 is(mro::get_mro('MRO_F'), 'c3');
  30 ok(eq_array(
  31     mro::get_linear_isa('MRO_F'),
  32     [qw/MRO_F MRO_D MRO_E MRO_A MRO_B MRO_C/]
  33 ));
  34
  35 my @isarev = sort { $a cmp $b } mro::get_isarev('MRO_B');
  36 ok(eq_array(
  37     \@isarev,
  38     [qw/MRO_D MRO_E MRO_F/]
  39 ));
  40
  41 ok(!mro::is_universal('MRO_B'));
  42
  43 @UNIVERSAL::ISA = qw/MRO_F/;
  44 ok(mro::is_universal('MRO_B'));
  45
  46 @UNIVERSAL::ISA = ();
  47 ok(mro::is_universal('MRO_B'));