This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Various mro updates from Brandon Black. References:
[perl5.git] / 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);