t/mro/isarev.t

   1 #!./perl
   2
   3 BEGIN {
   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
  11 use strict;
  12 use warnings;
  13 plan(tests => 24);
  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";
 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::;
 142 i phoo => qw [],
 143  'clobbering a class w/multiple layers of subclasses updates its parent';
 144
 145 @Thrat::ISA = 'Smin';
 146 %Thrat:: = ();
 147 i Smin => qw [], '%Package:: list assignment';