1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
#!./perl
BEGIN {
unless (-d 'blib') {
chdir 't' if -d 't';
}
require q(./test.pl);
set_up_inc('../lib') unless -d 'blib';
}
use strict;
use warnings;
plan(tests => 24);
use mro;
sub i {
my @args = @_;
@_
= (
join(" ", sort @{mro::get_isarev $args[0]}),
join(" ", sort @args[1..$#args-1]),
pop @args
);
goto &is;
}
# Basic isarev updating, when @ISA changes
@Pastern::ISA = "BodyPart::Ungulate";
@Scur::ISA = "BodyPart::Ungulate";
@BodyPart::Ungulate::ISA = "BodyPart";
i BodyPart => qw [ BodyPart::Ungulate Pastern Scur ],
'subclasses and subsubclasses are added to isarev';
@Pastern::ISA = ();
i BodyPart => qw [ BodyPart::Ungulate Scur ],
'single deletion from isarev';
@BodyPart::Ungulate::ISA = ();
i BodyPart => qw [ ], 'recursive deletion from isarev';
# except underneath it is not actually recursive
# More complicated tests that move packages around
@Huskey::ISA = "Dog";
@Dog::ISA = "Canid";
@Wolf::ISA = "Canid";
@Some::Brand::Name::ISA = "Dog::Bone";
@Dog::Bone::ISA = "Treat";
@Free::Time::ISA = "Treat";
@MyCollar::ISA = "Dog::Collar::Leather";
@Dog::Collar::Leather::ISA = "Collar";
@Another::Collar::ISA = "Collar";
*Tike:: = *Dog::;
delete $::{"Dog::"};
i Canid=>qw[ Wolf Tike ],
"deleting a stash elem updates isarev entries";
i Treat=>qw[ Free::Time Tike::Bone ],
"deleting a nested stash elem updates isarev entries";
i Collar=>qw[ Another::Collar Tike::Collar::Leather ],
"deleting a doubly nested stash elem updates isarev entries";
@Goat::ISA = "Ungulate";
@Goat::Dairy::ISA = "Goat";
@Goat::Dairy::Toggenburg::ISA = "Goat::Dairy";
@Weird::Thing::ISA = "g";
*g:: = *Goat::;
i Goat => qw[ Goat::Dairy Goat::Dairy::Toggenburg Weird::Thing ],
"isarev includes subclasses of aliases";
delete $::{"g::"};
i Ungulate => qw[ Goat Goat::Dairy Goat::Dairy::Toggenburg ],
"deleting an alias to a package updates isarev entries";
i"Goat" => qw[ Goat::Dairy Goat::Dairy::Toggenburg ],
"deleting an alias to a package updates isarev entries of nested stashes";
i"Goat::Dairy" => qw[ Goat::Dairy::Toggenburg ],
"deleting an stash alias updates isarev entries of doubly nested stashes";
i g => qw [ Weird::Thing ],
"subclasses of the deleted alias become part of its isarev";
@Caprine::ISA = "Hoofed::Mammal";
@Caprine::Dairy::ISA = "Caprine";
@Caprine::Dairy::Oberhasli::ISA = "Caprine::Dairy";
@Whatever::ISA = "Caprine";
*Caprid:: = *Caprine::;
*Caprine:: = *Chevre::;
i"Hoofed::Mammal" => qw[ Caprid ],
"replacing a stash updates isarev entries";
i Chevre => qw[ Caprid::Dairy Whatever ],
"replacing nested stashes updates isarev entries";
@Disease::Eye::ISA = "Disease";
@Disease::Eye::Infectious::ISA = "Disease::Eye";
@Keratoconjunctivitis::ISA = "Disease::Ophthalmic::Infectious";
*Disease::Ophthalmic:: = *Disease::Eye::;
{package some_random_new_symbol::Infectious} # autovivify
*Disease::Ophthalmic:: = *some_random_new_symbol::;
i Disease => qw[ Disease::Eye Disease::Eye::Infectious ],
"replacing an alias of a stash updates isarev entries";
i"Disease::Eye" => qw[ Disease::Eye::Infectious ],
"replacing an alias of a stash containing another updates isarev entries";
i"some_random_new_symbol::Infectious" => qw[ Keratoconjunctivitis ],
"replacing an alias updates isarev of stashes nested in the replacement";
# Globs ending with :: have autovivified stashes in them by default. We
# want one without a stash.
undef *Empty::;
@Null::ISA = "Empty";
@Null::Null::ISA = "Empty::Empty";
{package Zilch::Empty} # autovivify it
*Empty:: = *Zilch::;
i Zilch => qw[ Null ], "assigning to an empty spot updates isarev";
i"Zilch::Empty" => qw[ Null::Null ],
"assigning to an empty spot updates isarev of nested packages";
# Classes inheriting from multiple classes that get moved in a single
# assignment.
@foo::ISA = ("B", "B::B");
{package A::B}
my $A = \%A::; # keep a ref
*A:: = 'whatever'; # clobber it
*B:: = $A; # assign to two superclasses of foo at the same time
# There should be no A::B isarev entry.
i"A::B" => qw [], 'assigning to two superclasses at the same time';
ok !foo->isa("A::B"),
"A class must not inherit from its superclass's former name";
# undeffing globs
@alpha::ISA = 'beta';
$_ = \*alpha::ISA; # hang on to the glob
undef *alpha::ISA;
i beta => qw [], "undeffing an ISA glob deletes isarev entries";
@az::ISA = 'buki';
$_ = \*az::ISA;
undef *az::;
i buki => qw [], "undeffing a package glob deletes isarev entries";
# Package aliasing/clobbering when the clobbered package has grandchildren
# by inheritance.
@bar::ISA = 'phoo';
@subclassA::ISA = "subclassB";
@subclassB::ISA = "bar";
*bar:: = *baz::;
i phoo => qw [],
'clobbering a class w/multiple layers of subclasses updates its parent';
@Thrat::ISA = 'Smin';
%Thrat:: = ();
i Smin => qw [], '%Package:: list assignment';
|
