t/mro/basic.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5
   6 require q(./test.pl); plan(tests => 12);
   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'));
  48
  49 # is_universal, get_mro, and get_linear_isa should
  50 # handle non-existant packages sanely
  51 ok(!mro::is_universal('Does_Not_Exist'));
  52 is(mro::get_mro('Also_Does_Not_Exist'), 'dfs');
  53 ok(eq_array(
  54     mro::get_linear_isa('Does_Not_Exist_Three'),
  55     [qw/Does_Not_Exist_Three/]
  56 ));
  57
  58 # Assigning @ISA via globref
  59 {
  60     package MRO_TestBase;
  61     sub testfunc { return 123 }
  62     package MRO_TestOtherBase;
  63     sub testfunctwo { return 321 }
  64     package MRO_M; our @ISA = qw/MRO_TestBase/;
  65 }
  66 *MRO_N::ISA = *MRO_M::ISA;
  67 is(eval { MRO_N->testfunc() }, 123);
  68
  69 # XXX TODO (when there's a way to backtrack through a glob's aliases)
  70 # push(@MRO_M::ISA, 'MRO_TestOtherBase');
  71 # is(eval { MRO_N->testfunctwo() }, 321);