#!./perl BEGIN { unless (-d 'blib') { chdir 't' if -d 't'; @INC = '../lib'; } require q(./test.pl); } 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';