OS2-Process/Process.pm: Fix broken pod links

[perl5.git] / t / mro / isarev.t

#!./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';