6 require q(./test.pl); plan(tests => 21);
16 our @ISA = qw/MRO_A MRO_B MRO_C/;
18 our @ISA = qw/MRO_A MRO_B MRO_C/;
20 our @ISA = qw/MRO_D MRO_E/;
23 is(mro::get_mro('MRO_F'), 'dfs');
25 mro::get_linear_isa('MRO_F'),
26 [qw/MRO_F MRO_D MRO_A MRO_B MRO_C MRO_E/]
28 mro::set_mro('MRO_F', 'c3');
29 is(mro::get_mro('MRO_F'), 'c3');
31 mro::get_linear_isa('MRO_F'),
32 [qw/MRO_F MRO_D MRO_E MRO_A MRO_B MRO_C/]
35 my @isarev = sort { $a cmp $b } @{mro::get_isarev('MRO_B')};
38 [qw/MRO_D MRO_E MRO_F/]
41 ok(!mro::is_universal('MRO_B'));
43 @UNIVERSAL::ISA = qw/MRO_F/;
44 ok(mro::is_universal('MRO_B'));
47 ok(mro::is_universal('MRO_B'));
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');
54 mro::get_linear_isa('Does_Not_Exist_Three'),
55 [qw/Does_Not_Exist_Three/]
58 # Assigning @ISA via globref
61 sub testfunc { return 123 }
62 package MRO_TestOtherBase;
63 sub testfunctwo { return 321 }
64 package MRO_M; our @ISA = qw/MRO_TestBase/;
66 *MRO_N::ISA = *MRO_M::ISA;
67 is(eval { MRO_N->testfunc() }, 123);
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);
73 # Simple DESTROY Baseline
79 package DESTROY_MRO_Baseline;
80 sub new { bless {} => shift }
83 package DESTROY_MRO_Baseline_Child;
84 our @ISA = qw/DESTROY_MRO_Baseline/;
87 $obj = DESTROY_MRO_Baseline->new();
91 $obj = DESTROY_MRO_Baseline_Child->new();
102 package DESTROY_MRO_Dynamic;
103 sub new { bless {} => shift }
105 package DESTROY_MRO_Dynamic_Child;
106 our @ISA = qw/DESTROY_MRO_Dynamic/;
109 $obj = DESTROY_MRO_Dynamic->new();
113 $obj = DESTROY_MRO_Dynamic_Child->new();
118 *DESTROY_MRO_Dynamic::DESTROY = sub { $x++ };
120 $obj = DESTROY_MRO_Dynamic->new();
124 $obj = DESTROY_MRO_Dynamic_Child->new();
129 # clearing @ISA in different ways
130 # some are destructive to the package, hence the new
131 # package name each time
133 no warnings 'uninitialized';
136 our @ISA = qw/XX YY ZZ/;
139 ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR XX YY ZZ/]));
141 # this looks dumb, but it preserves existing behavior for compatibility
142 # (undefined @ISA elements treated as "main")
143 $ISACLEAR::ISA[1] = undef;
144 ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR XX main ZZ/]));
146 # undef the array itself
147 undef @ISACLEAR::ISA;
148 ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR/]));