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