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
1 #!./perl
2
3 BEGIN {
4     unless (-d 'blib') {
5         chdir 't' if -d 't';
6         @INC = '../lib';
7     }
8     require q(./test.pl);
9 }
10
11 use strict;
12 use warnings;
13 plan(tests => 22);
14
15 use mro;
16
17 sub i {
18  my @args = @_;
19  @_
20   = (
21      join(" ", sort @{mro::get_isarev $args[0]}),
22      join(" ", sort @args[1..$#args-1]),
23      pop @args
24     );
25  goto &is;
26 }
27
28 # Basic isarev updating, when @ISA changes
29 @Pastern::ISA = "BodyPart::Ungulate";
30 @Scur::ISA    = "BodyPart::Ungulate";
31 @BodyPart::Ungulate::ISA = "BodyPart";
32 i BodyPart => qw [ BodyPart::Ungulate Pastern Scur ],
33  'subclasses and subsubclasses are added to isarev';
34 @Pastern::ISA = ();
35 i BodyPart => qw [ BodyPart::Ungulate Scur ],
36  'single deletion from isarev';
37 @BodyPart::Ungulate::ISA = ();
38 i BodyPart => qw [ ], 'recursive deletion from isarev';
39                       # except underneath it is not actually recursive
40
41
42 # More complicated tests that move packages around
43
44 @Huskey::ISA = "Dog";
45 @Dog::ISA = "Canid";
46 @Wolf::ISA = "Canid";
47 @Some::Brand::Name::ISA = "Dog::Bone";
48 @Dog::Bone::ISA = "Treat";
49 @Free::Time::ISA = "Treat";
50 @MyCollar::ISA = "Dog::Collar::Leather";
51 @Dog::Collar::Leather::ISA = "Collar";
52 @Another::Collar::ISA = "Collar";
53 *Tike:: = *Dog::;
54 delete $::{"Dog::"};
55 i Canid=>qw[ Wolf Tike ],
56  "deleting a stash elem updates isarev entries";
57 i Treat=>qw[ Free::Time Tike::Bone ],
58  "deleting a nested stash elem updates isarev entries";
59 i 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::;
67 i Goat => qw[ Goat::Dairy Goat::Dairy::Toggenburg Weird::Thing ],
68  "isarev includes subclasses of aliases";
69 delete $::{"g::"};
70 i Ungulate => qw[ Goat Goat::Dairy Goat::Dairy::Toggenburg ],
71  "deleting an alias to a package updates isarev entries";
72 i"Goat" => qw[ Goat::Dairy Goat::Dairy::Toggenburg ],
73  "deleting an alias to a package updates isarev entries of nested stashes";
74 i"Goat::Dairy" => qw[ Goat::Dairy::Toggenburg ],
75  "deleting an stash alias updates isarev entries of doubly nested stashes";
76 i 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::;
85 i"Hoofed::Mammal" => qw[ Caprid ],
86  "replacing a stash updates isarev entries";
87 i Chevre => qw[ Caprid::Dairy Whatever ],
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::;
94 {package some_random_new_symbol::Infectious} # autovivify
95 *Disease::Ophthalmic:: = *some_random_new_symbol::;
96 i Disease => qw[ Disease::Eye Disease::Eye::Infectious ],
97  "replacing an alias of a stash updates isarev entries";
98 i"Disease::Eye" => qw[ Disease::Eye::Infectious ],
99  "replacing an alias of a stash containing another updates isarev entries";
100 i"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.
105 undef *Empty::;
106 @Null::ISA = "Empty";
107 @Null::Null::ISA = "Empty::Empty";
108 {package Zilch::Empty} # autovivify it
109 *Empty:: = *Zilch::;
110 i Zilch => qw[ Null ], "assigning to an empty spot updates isarev";
111 i"Zilch::Empty" => qw[ Null::Null ],
112  "assigning to an empty spot updates isarev of nested packages";
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}
118 my $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.
122 i"A::B" => qw [], 'assigning to two superclasses at the same time';
123 ok !foo->isa("A::B"),
124  "A class must not inherit from its superclass’s former name";
125
126 # undeffing globs
127 @alpha::ISA = 'beta';
128 $_ = \*alpha::ISA;    # hang on to the glob
129 undef *alpha::ISA;
130 i beta => qw [], "undeffing an ISA glob deletes isarev entries";
131 @az::ISA = 'buki';
132 $_ = \*az::ISA;
133 undef *az::;
134 i buki => qw [], "undeffing a package glob deletes isarev entries";