1#!./perl 2 3BEGIN { 4 unless (-d 'blib') { 5 chdir 't' if -d 't'; 6 } 7 require q(./test.pl); 8 set_up_inc('../lib') unless -d 'blib'; 9} 10 11use strict; 12use warnings; 13plan(tests => 24); 14 15use mro; 16 17sub 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"; 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 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::; 54delete $::{"Dog::"}; 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"; 87i 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::; 96i Disease => qw[ Disease::Eye Disease::Eye::Infectious ], 97 "replacing an alias of a stash updates isarev entries"; 98i"Disease::Eye" => qw[ Disease::Eye::Infectious ], 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"; 111i"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} 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"; 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"; 135 136# Package aliasing/clobbering when the clobbered package has grandchildren 137# by inheritance. 138@bar::ISA = 'phoo'; 139@subclassA::ISA = "subclassB"; 140@subclassB::ISA = "bar"; 141*bar:: = *baz::; 142i phoo => qw [], 143 'clobbering a class w/multiple layers of subclasses updates its parent'; 144 145@Thrat::ISA = 'Smin'; 146%Thrat:: = (); 147i Smin => qw [], '%Package:: list assignment'; 148