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

#!./perl

BEGIN {
    unless (-d 'blib') {
        chdir 't' if -d 't';
    }
    require q(./test.pl);
    set_up_inc('../lib');
}

use strict;
use warnings;
plan(tests => 54);

{
    package New;
    use strict;
    use warnings;

    package Old;
    use strict;
    use warnings;

    {
      no strict 'refs';
      *{'Old::'} = *{'New::'};
    }
}

ok (Old->isa (New::), 'Old inherits from New');
ok (New->isa (Old::), 'New inherits from Old');

object_ok (bless ({}, Old::), New::, 'Old object');
object_ok (bless ({}, New::), Old::, 'New object');


# Test that replacing a package by assigning to an existing glob
# invalidates the isa caches
for(
 {
   name => 'assigning a glob to a glob',
   code => '$life_raft = $::{"Left::"}; *Left:: = $::{"Right::"}',
 },
 {
   name => 'assigning a string to a glob',
   code => '$life_raft = $::{"Left::"}; *Left:: = "Right::"',
 },
 {
   name => 'assigning a stashref to a glob',
   code => '$life_raft = \%Left::; *Left:: = \%Right::',
 },
) {
 fresh_perl_is
   q~
     @Subclass::ISA = "Left";
     @Left::ISA = "TopLeft";

     sub TopLeft::speak { "Woof!" }
     sub TopRight::speak { "Bow-wow!" }

     my $thing = bless [], "Subclass";

     # mro_package_moved needs to know to skip non-globs
     $Right::{"gleck::"} = 3;

     @Right::ISA = 'TopRight';
     my $life_raft;
    __code__;

     print $thing->speak, "\n";

     undef $life_raft;
     print $thing->speak, "\n";
   ~ =~ s\__code__\$$_{code}\r,
  "Bow-wow!\nBow-wow!\n",
   {},
  "replacing packages by $$_{name} updates isa caches";
}

# Similar test, but with nested packages
#
#  TopLeft (Woof)    TopRight (Bow-wow)
#      |                 |
#  Left::Side   <-   Right::Side
#      |
#   Subclass
#
# This test assigns Right:: to Left::, indirectly making Left::Side an
# alias to Right::Side (following the arrow in the diagram).
for(
 {
   name => 'assigning a glob to a glob',
   code => '$life_raft = $::{"Left::"}; *Left:: = $::{"Right::"}',
 },
 {
   name => 'assigning a string to a glob',
   code => '$life_raft = $::{"Left::"}; *Left:: = "Right::"',
 },
 {
   name => 'assigning a stashref to a glob',
   code => '$life_raft = \%Left::; *Left:: = \%Right::',
 },
) {
 fresh_perl_is
   q~
     @Subclass::ISA = "Left::Side";
     @Left::Side::ISA = "TopLeft";

     sub TopLeft::speak { "Woof!" }
     sub TopRight::speak { "Bow-wow!" }

     my $thing = bless [], "Subclass";

     @Right::Side::ISA = 'TopRight';
     my $life_raft;
    __code__;

     print $thing->speak, "\n";

     undef $life_raft;
     print $thing->speak, "\n";
   ~ =~ s\__code__\$$_{code}\r,
  "Bow-wow!\nBow-wow!\n",
   {},
  "replacing nested packages by $$_{name} updates isa caches";
}

# Another nested package test, in which the isa cache needs to be reset on
# the subclass of a package that does not exist.
#
# Parenthesized packages do not exist.
#
#  outer::inner    ( clone::inner )
#       |                 |
#     left              right
#
#        outer  ->  clone
#
# This test assigns outer:: to clone::, making clone::inner an alias to
# outer::inner.
#
# Then we also run the test again, but without outer::inner
for(
 {
   name => 'assigning a glob to a glob',
   code => '*clone:: = *outer::',
 },
 {
   name => 'assigning a string to a glob',
   code => '*clone:: = "outer::"',
 },
 {
   name => 'assigning a stashref to a glob',
   code => '*clone:: = \%outer::',
 },
) {
 for my $tail ('inner', 'inner::', 'inner:::', 'inner::::') {
  fresh_perl_is
    q~
      my $tail = shift;
      @left::ISA = "outer::$tail";
      @right::ISA = "clone::$tail";
      bless [], "outer::$tail"; # autovivify the stash

     __code__;

      print "ok 1", "\n" if left->isa("clone::$tail");
      print "ok 2", "\n" if right->isa("outer::$tail");
      print "ok 3", "\n" if right->isa("clone::$tail");
      print "ok 4", "\n" if left->isa("outer::$tail");
    ~ =~ s\__code__\$$_{code}\r,
   "ok 1\nok 2\nok 3\nok 4\n",
    { args => [$tail] },
   "replacing nonexistent nested packages by $$_{name} updates isa caches"
     ." ($tail)";

  # Same test but with the subpackage autovivified after the assignment
  fresh_perl_is
    q~
      my $tail = shift;
      @left::ISA = "outer::$tail";
      @right::ISA = "clone::$tail";

     __code__;

      bless [], "outer::$tail";

      print "ok 1", "\n" if left->isa("clone::$tail");
      print "ok 2", "\n" if right->isa("outer::$tail");
      print "ok 3", "\n" if right->isa("clone::$tail");
      print "ok 4", "\n" if left->isa("outer::$tail");
    ~ =~ s\__code__\$$_{code}\r,
   "ok 1\nok 2\nok 3\nok 4\n",
    { args => [$tail] },
   "Giving nonexistent packages multiple effective names by $$_{name}"
     . " ($tail)";
 }
}

no warnings; # temporary; there seems to be a scoping bug, as this does not
             # work when placed in the blocks below

# Test that deleting stash elements containing
# subpackages also invalidates the isa cache.
# Maybe this does not belong in package_aliases.t, but it is closely
# related to the tests immediately preceding.
{
 @Pet::ISA = ("Cur", "Hound");
 @Cur::ISA = "Hylactete";

 sub Hylactete::speak { "Arff!" }
 sub Hound::speak { "Woof!" }

 my $pet = bless [], "Pet";

 my $life_raft = delete $::{'Cur::'};

 is $pet->speak, 'Woof!',
  'deleting a stash from its parent stash invalidates the isa caches';

 undef $life_raft;
 is $pet->speak, 'Woof!',
  'the deleted stash is gone completely when freed';
}
# Same thing, but with nested packages
{
 @Pett::ISA = ("Curr::Curr::Curr", "Hownd");
 @Curr::Curr::Curr::ISA = "Latrator";

 sub Latrator::speak { "Arff!" }
 sub Hownd::speak { "Woof!" }

 my $pet = bless [], "Pett";

 my $life_raft = delete $::{'Curr::'};

 is $pet->speak, 'Woof!',
  'deleting a stash from its parent stash resets caches of substashes';

 undef $life_raft;
 is $pet->speak, 'Woof!',
  'the deleted substash is gone completely when freed';
}

# [perl #77358]
fresh_perl_is
   q~#!perl -w
     @Pet::ISA = "Tike";
     @Tike::ISA = "Barker";
     
     sub Barker::speak { print "Woof!\n" }
     sub Latrator::speak { print "Bow-wow!\n" }
     
     my $pet = bless [], "Pet";
     
     $pet->speak;
     
     sub Dog::speak { print "Hello.\n" } # strange dog!
     @Dog::ISA = 'Latrator';
     *Tike:: = delete $::{'Dog::'};
     
     $pet->speak;
   ~,
  "Woof!\nHello.\n",
   { stderr => 1 },
  "Assigning a nameless package over one w/subclasses updates isa caches";

# mro_package_moved needs to make a distinction between replaced and
# assigned stashes when keeping track of what it has seen so far.
no warnings; {
    no strict 'refs';

    sub bar::blonk::blonk::phoo { "bbb" }
    sub veclum::phoo { "lasrevinu" }
    @feedlebomp::ISA = qw 'phoo::blonk::blonk veclum';
    *phoo::baz:: = *bar::blonk::;   # now bar::blonk:: is on both sides
    *phoo:: = *bar::;         # here bar::blonk:: is both deleted and added
    *bar:: = *boo::;          # now it is only known as phoo::blonk::

    # At this point, before the bug was fixed, %phoo::blonk::blonk:: ended
    # up with no effective name, allowing it to be deleted without updating
    # its subclasses’ caches.

    my $accum = '';

    $accum .= 'feedlebomp'->phoo;          # bbb
    delete ${"phoo::blonk::"}{"blonk::"};
    $accum .= 'feedlebomp'->phoo;          # bbb (Oops!)
    @feedlebomp::ISA = @feedlebomp::ISA;
    $accum .= 'feedlebomp'->phoo;          # lasrevinu

    is $accum, 'bbblasrevinulasrevinu',
      'nested classes deleted & added simultaneously';
}
use warnings;

# mro_package_moved needs to check for self-referential packages.
# This broke Text::Template [perl #78362].
watchdog 3;
*foo:: = \%::;
*Acme::META::Acme:: = \*Acme::; # indirect self-reference
pass("mro_package_moved and self-referential packages");

# Deleting a glob whose name does not indicate its location in the symbol
# table but which nonetheless *is* in the symbol table.
{
    no strict refs=>;
    no warnings;
    @one::more::ISA = "four";
    sub four::womp { "aoeaa" }
    *two:: = *one::;
    delete $::{"one::"};
    @Childclass::ISA = 'two::more';
    my $accum = 'Childclass'->womp . '-';
    my $life_raft = delete ${"two::"}{"more::"};
    $accum .= eval { 'Childclass'->womp } // '<undef>';
    is $accum, 'aoeaa-<undef>',
     'Deleting globs whose loc in the symtab differs from gv_fullname'
}

# Pathological test for undeffing a stash that has an alias.
*Ghelp:: = *Neen::;
@Subclass::ISA = 'Ghelp';
undef %Ghelp::;
sub Frelp::womp { "clumpren" }
eval '
  $Neen::whatever++;
  @Neen::ISA = "Frelp";
';
is eval { 'Subclass'->womp }, 'clumpren',
 'Changes to @ISA after undef via original name';
undef %Ghelp::;
eval '
  $Ghelp::whatever++;
  @Ghelp::ISA = "Frelp";
';
is eval { 'Subclass'->womp }, 'clumpren',
 'Changes to @ISA after undef via alias';


# Packages whose containing stashes have aliases must lose all names cor-
# responding to that container when detached.
{
 {package smare::baz} # autovivify
 *phring:: = *smare::;  # smare::baz now also named phring::baz
 *bonk:: = delete $smare::{"baz::"};
 # In 5.13.7, it has now lost its smare::baz name (reverting to phring::baz
 # as the effective name), and gained bonk as an alias.
 # In 5.13.8, both smare::baz *and* phring::baz names are deleted.

 # Make some methods
 no strict 'refs';
 *{"phring::baz::frump"} = sub { "hello" };
 sub frumper::frump { "good bye" };

 @brumkin::ISA = qw "bonk frumper"; # now wrongly inherits from phring::baz

 is frump brumkin, "good bye",
  'detached stashes lose all names corresponding to the containing stash';
}

# Crazy edge cases involving packages ending with a single :
@Colon::ISA = 'Organ:'; # pun intended!
bless [], "Organ:"; # autovivify the stash
ok "Colon"->isa("Organ:"), 'class isa "class:"';
{ no strict 'refs'; *{"Organ:::"} = *Organ:: }
ok "Colon"->isa("Organ"),
 'isa(foo) when inheriting from "class:" which is an alias for foo';
{
 no warnings;
 # The next line of code is *not* normative. If the structure changes,
 # this line needs to change, too.
 my $foo = delete $Organ::{":"};
 ok !Colon->isa("Organ"),
  'class that isa "class:" no longer isa foo if "class:" has been deleted';
}
@Colon::ISA = ':';
bless [], ":";
ok "Colon"->isa(":"), 'class isa ":"';
{ no strict 'refs'; *{":::"} = *Punctuation:: }
ok "Colon"->isa("Punctuation"),
 'isa(foo) when inheriting from ":" which is an alias for foo';
@Colon::ISA = 'Organ:';
bless [], "Organ:";
{
 no strict 'refs';
 my $life_raft = \%{"Organ:::"};
 *{"Organ:::"} = \%Organ::;
 ok "Colon"->isa("Organ"),
  'isa(foo) when inheriting from "class:" after hash-to-glob assignment';
}
@Colon::ISA = 'O:';
bless [], "O:";
{
 no strict 'refs';
 my $life_raft = \%{"O:::"};
 *{"O:::"} = "Organ::";
 ok "Colon"->isa("Organ"),
  'isa(foo) when inheriting from "class:" after string-to-glob assignment';
}

@Bazo::ISA = "Fooo::bar";
sub Fooo::bar::ber { 'baz' }
sub UNIVERSAL::ber { "black sheep" }
Bazo->ber;
local *Fooo:: = \%Baro::;
{
    no warnings;
    is 'Bazo'->ber, 'black sheep', 'localised *glob=$stashref assignment';
}

# $Stash::{"entries::"} that are not globs.
# These used to crash.
$NotGlob::{"NotGlob::"} = 0; () = $NewNotGlob::NotGlob::;
*NewNotGlob:: = *NotGlob::;
pass(
   "no crash when clobbering sub-'stash' whose parent stash entry is no GV"
);
Commit	Line	Data
0643ac23 TS	1	#!./perl
	2
	3	BEGIN {
	4	unless (-d 'blib') {
	5	chdir 't' if -d 't';
0643ac23	6	}
c8bbf675	7	require q(./test.pl);
624c42e2	8	set_up_inc('../lib');
0643ac23 TS	9	}
	10
	11	use strict;
	12	use warnings;
3d8812a2	13	plan(tests => 54);
0643ac23 TS	14
	15	{
	16	package New;
	17	use strict;
	18	use warnings;
	19
	20	package Old;
	21	use strict;
	22	use warnings;
	23
	24	{
	25	no strict 'refs';
	26	{'Old::'} = {'New::'};
	27	}
	28	}
	29
	30	ok (Old->isa (New::), 'Old inherits from New');
	31	ok (New->isa (Old::), 'New inherits from Old');
	32
bbce3ca6 MS	33	object_ok (bless ({}, Old::), New::, 'Old object');
bbce3ca6 MS	34	object_ok (bless ({}, New::), Old::, 'New object');
c8bbf675 FC	35
c8bbf675 FC	36
c8bbf675 FC	37	# Test that replacing a package by assigning to an existing glob
c8bbf675 FC	38	# invalidates the isa caches
3e79609f FC	39	for(
	40	{
	41	name => 'assigning a glob to a glob',
	42	code => '$life_raft = $::{"Left::"}; *Left:: = $::{"Right::"}',
	43	},
	44	{
	45	name => 'assigning a string to a glob',
	46	code => '$life_raft = $::{"Left::"}; *Left:: = "Right::"',
	47	},
	48	{
	49	name => 'assigning a stashref to a glob',
	50	code => '$life_raft = \%Left::; *Left:: = \%Right::',
	51	},
	52	) {
	53	fresh_perl_is
	54	q~
	55	@Subclass::ISA = "Left";
	56	@Left::ISA = "TopLeft";
	57
	58	sub TopLeft::speak { "Woof!" }
	59	sub TopRight::speak { "Bow-wow!" }
	60
	61	my $thing = bless [], "Subclass";
	62
	63	# mro_package_moved needs to know to skip non-globs
	64	$Right::{"gleck::"} = 3;
	65
	66	@Right::ISA = 'TopRight';
	67	my $life_raft;
	68	__code__;
	69
	70	print $thing->speak, "\n";
	71
	72	undef $life_raft;
	73	print $thing->speak, "\n";
	74	~ =~ s\__code__\$$_{code}\r,
	75	"Bow-wow!\nBow-wow!\n",
	76	{},
	77	"replacing packages by $$_{name} updates isa caches";
c8bbf675 FC	78	}
	79
	80	# Similar test, but with nested packages
54b65169 FC	81	#
	82	# TopLeft (Woof) TopRight (Bow-wow)
	83	# \| \|
	84	# Left::Side <- Right::Side
	85	# \|
	86	# Subclass
	87	#
	88	# This test assigns Right:: to Left::, indirectly making Left::Side an
	89	# alias to Right::Side (following the arrow in the diagram).
3e79609f FC	90	for(
	91	{
	92	name => 'assigning a glob to a glob',
	93	code => '$life_raft = $::{"Left::"}; *Left:: = $::{"Right::"}',
	94	},
	95	{
	96	name => 'assigning a string to a glob',
	97	code => '$life_raft = $::{"Left::"}; *Left:: = "Right::"',
	98	},
	99	{
	100	name => 'assigning a stashref to a glob',
	101	code => '$life_raft = \%Left::; *Left:: = \%Right::',
	102	},
	103	) {
	104	fresh_perl_is
	105	q~
	106	@Subclass::ISA = "Left::Side";
	107	@Left::Side::ISA = "TopLeft";
	108
	109	sub TopLeft::speak { "Woof!" }
	110	sub TopRight::speak { "Bow-wow!" }
	111
	112	my $thing = bless [], "Subclass";
	113
	114	@Right::Side::ISA = 'TopRight';
	115	my $life_raft;
	116	__code__;
	117
	118	print $thing->speak, "\n";
	119
	120	undef $life_raft;
	121	print $thing->speak, "\n";
	122	~ =~ s\__code__\$$_{code}\r,
	123	"Bow-wow!\nBow-wow!\n",
	124	{},
	125	"replacing nested packages by $$_{name} updates isa caches";
c8bbf675 FC	126	}
c8bbf675 FC	127
d056e33c FC	128	# Another nested package test, in which the isa cache needs to be reset on
	129	# the subclass of a package that does not exist.
	130	#
	131	# Parenthesized packages do not exist.
	132	#
	133	# outer::inner ( clone::inner )
	134	# \| \|
	135	# left right
	136	#
	137	# outer -> clone
	138	#
	139	# This test assigns outer:: to clone::, making clone::inner an alias to
	140	# outer::inner.
298d6511 FC	141	#
298d6511 FC	142	# Then we also run the test again, but without outer::inner
d056e33c FC	143	for(
	144	{
	145	name => 'assigning a glob to a glob',
	146	code => 'clone:: = outer::',
	147	},
	148	{
	149	name => 'assigning a string to a glob',
	150	code => '*clone:: = "outer::"',
	151	},
	152	{
	153	name => 'assigning a stashref to a glob',
	154	code => '*clone:: = \%outer::',
	155	},
	156	) {
1f656fcf	157	for my $tail ('inner', 'inner::', 'inner:::', 'inner::::') {
088225fd FC	158	fresh_perl_is
	159	q~
	160	my $tail = shift;
	161	@left::ISA = "outer::$tail";
	162	@right::ISA = "clone::$tail";
1f656fcf	163	bless [], "outer::$tail"; # autovivify the stash
088225fd FC	164
	165	__code__;
	166
	167	print "ok 1", "\n" if left->isa("clone::$tail");
	168	print "ok 2", "\n" if right->isa("outer::$tail");
	169	print "ok 3", "\n" if right->isa("clone::$tail");
	170	print "ok 4", "\n" if left->isa("outer::$tail");
	171	~ =~ s\__code__\$$_{code}\r,
	172	"ok 1\nok 2\nok 3\nok 4\n",
	173	{ args => [$tail] },
	174	"replacing nonexistent nested packages by $$_{name} updates isa caches"
	175	." ($tail)";
	176
	177	# Same test but with the subpackage autovivified after the assignment
	178	fresh_perl_is
	179	q~
	180	my $tail = shift;
	181	@left::ISA = "outer::$tail";
	182	@right::ISA = "clone::$tail";
	183
	184	__code__;
	185
1f656fcf	186	bless [], "outer::$tail";
088225fd FC	187
	188	print "ok 1", "\n" if left->isa("clone::$tail");
	189	print "ok 2", "\n" if right->isa("outer::$tail");
	190	print "ok 3", "\n" if right->isa("clone::$tail");
	191	print "ok 4", "\n" if left->isa("outer::$tail");
	192	~ =~ s\__code__\$$_{code}\r,
	193	"ok 1\nok 2\nok 3\nok 4\n",
	194	{ args => [$tail] },
	195	"Giving nonexistent packages multiple effective names by $$_{name}"
	196	. " ($tail)";
	197	}
d056e33c FC	198	}
d056e33c FC	199
0d93988a FC	200	no warnings; # temporary; there seems to be a scoping bug, as this does not
	201	# work when placed in the blocks below
	202
c8bbf675 FC	203	# Test that deleting stash elements containing
	204	# subpackages also invalidates the isa cache.
	205	# Maybe this does not belong in package_aliases.t, but it is closely
	206	# related to the tests immediately preceding.
	207	{
	208	@Pet::ISA = ("Cur", "Hound");
	209	@Cur::ISA = "Hylactete";
	210
	211	sub Hylactete::speak { "Arff!" }
	212	sub Hound::speak { "Woof!" }
	213
	214	my $pet = bless [], "Pet";
	215
	216	my $life_raft = delete $::{'Cur::'};
	217
	218	is $pet->speak, 'Woof!',
	219	'deleting a stash from its parent stash invalidates the isa caches';
	220
	221	undef $life_raft;
	222	is $pet->speak, 'Woof!',
	223	'the deleted stash is gone completely when freed';
	224	}
4f6b8b29 FC	225	# Same thing, but with nested packages
	226	{
	227	@Pett::ISA = ("Curr::Curr::Curr", "Hownd");
	228	@Curr::Curr::Curr::ISA = "Latrator";
	229
	230	sub Latrator::speak { "Arff!" }
	231	sub Hownd::speak { "Woof!" }
	232
	233	my $pet = bless [], "Pett";
	234
	235	my $life_raft = delete $::{'Curr::'};
	236
	237	is $pet->speak, 'Woof!',
	238	'deleting a stash from its parent stash resets caches of substashes';
	239
	240	undef $life_raft;
	241	is $pet->speak, 'Woof!',
	242	'the deleted substash is gone completely when freed';
	243	}
	244
0d93988a FC	245	# [perl #77358]
	246	fresh_perl_is
	247	q~#!perl -w
	248	@Pet::ISA = "Tike";
	249	@Tike::ISA = "Barker";
	250
	251	sub Barker::speak { print "Woof!\n" }
	252	sub Latrator::speak { print "Bow-wow!\n" }
	253
	254	my $pet = bless [], "Pet";
	255
	256	$pet->speak;
	257
	258	sub Dog::speak { print "Hello.\n" } # strange dog!
	259	@Dog::ISA = 'Latrator';
	260	*Tike:: = delete $::{'Dog::'};
	261
	262	$pet->speak;
	263	~,
	264	"Woof!\nHello.\n",
	265	{ stderr => 1 },
	266	"Assigning a nameless package over one w/subclasses updates isa caches";
	267
b89cdb22 FC	268	# mro_package_moved needs to make a distinction between replaced and
	269	# assigned stashes when keeping track of what it has seen so far.
	270	no warnings; {
	271	no strict 'refs';
	272
	273	sub bar::blonk::blonk::phoo { "bbb" }
	274	sub veclum::phoo { "lasrevinu" }
	275	@feedlebomp::ISA = qw 'phoo::blonk::blonk veclum';
	276	phoo::baz:: = bar::blonk::; # now bar::blonk:: is on both sides
	277	phoo:: = bar::; # here bar::blonk:: is both deleted and added
	278	bar:: = boo::; # now it is only known as phoo::blonk::
	279
	280	# At this point, before the bug was fixed, %phoo::blonk::blonk:: ended
	281	# up with no effective name, allowing it to be deleted without updating
	282	# its subclasses’ caches.
	283
	284	my $accum = '';
	285
	286	$accum .= 'feedlebomp'->phoo; # bbb
	287	delete ${"phoo::blonk::"}{"blonk::"};
	288	$accum .= 'feedlebomp'->phoo; # bbb (Oops!)
	289	@feedlebomp::ISA = @feedlebomp::ISA;
	290	$accum .= 'feedlebomp'->phoo; # lasrevinu
	291
	292	is $accum, 'bbblasrevinulasrevinu',
	293	'nested classes deleted & added simultaneously';
	294	}
	295	use warnings;
62c1e33f FC	296
	297	# mro_package_moved needs to check for self-referential packages.
	298	# This broke Text::Template [perl #78362].
	299	watchdog 3;
	300	*foo:: = \%::;
	301	Acme::META::Acme:: = \Acme::; # indirect self-reference
	302	pass("mro_package_moved and self-referential packages");
0290c710 FC	303
	304	# Deleting a glob whose name does not indicate its location in the symbol
	305	# table but which nonetheless is in the symbol table.
	306	{
	307	no strict refs=>;
	308	no warnings;
	309	@one::more::ISA = "four";
	310	sub four::womp { "aoeaa" }
	311	two:: = one::;
	312	delete $::{"one::"};
	313	@Childclass::ISA = 'two::more';
	314	my $accum = 'Childclass'->womp . '-';
	315	my $life_raft = delete ${"two::"}{"more::"};
	316	$accum .= eval { 'Childclass'->womp } // '<undef>';
	317	is $accum, 'aoeaa-<undef>',
	318	'Deleting globs whose loc in the symtab differs from gv_fullname'
	319	}
745edda6 FC	320
	321	# Pathological test for undeffing a stash that has an alias.
	322	Ghelp:: = Neen::;
	323	@Subclass::ISA = 'Ghelp';
	324	undef %Ghelp::;
	325	sub Frelp::womp { "clumpren" }
	326	eval '
	327	$Neen::whatever++;
	328	@Neen::ISA = "Frelp";
	329	';
	330	is eval { 'Subclass'->womp }, 'clumpren',
	331	'Changes to @ISA after undef via original name';
	332	undef %Ghelp::;
	333	eval '
	334	$Ghelp::whatever++;
	335	@Ghelp::ISA = "Frelp";
	336	';
	337	is eval { 'Subclass'->womp }, 'clumpren',
	338	'Changes to @ISA after undef via alias';
d7879cf0 FC	339
	340
	341	# Packages whose containing stashes have aliases must lose all names cor-
	342	# responding to that container when detached.
	343	{
	344	{package smare::baz} # autovivify
	345	phring:: = smare::; # smare::baz now also named phring::baz
	346	*bonk:: = delete $smare::{"baz::"};
	347	# In 5.13.7, it has now lost its smare::baz name (reverting to phring::baz
	348	# as the effective name), and gained bonk as an alias.
	349	# In 5.13.8, both smare::baz and phring::baz names are deleted.
	350
	351	# Make some methods
	352	no strict 'refs';
	353	*{"phring::baz::frump"} = sub { "hello" };
	354	sub frumper::frump { "good bye" };
	355
	356	@brumkin::ISA = qw "bonk frumper"; # now wrongly inherits from phring::baz
	357
	358	is frump brumkin, "good bye",
	359	'detached stashes lose all names corresponding to the containing stash';
	360	}
1f656fcf FC	361
	362	# Crazy edge cases involving packages ending with a single :
	363	@Colon::ISA = 'Organ:'; # pun intended!
	364	bless [], "Organ:"; # autovivify the stash
	365	ok "Colon"->isa("Organ:"), 'class isa "class:"';
	366	{ no strict 'refs'; {"Organ:::"} = Organ:: }
	367	ok "Colon"->isa("Organ"),
	368	'isa(foo) when inheriting from "class:" which is an alias for foo';
	369	{
	370	no warnings;
	371	# The next line of code is not normative. If the structure changes,
	372	# this line needs to change, too.
	373	my $foo = delete $Organ::{":"};
	374	ok !Colon->isa("Organ"),
	375	'class that isa "class:" no longer isa foo if "class:" has been deleted';
	376	}
	377	@Colon::ISA = ':';
	378	bless [], ":";
	379	ok "Colon"->isa(":"), 'class isa ":"';
	380	{ no strict 'refs'; {":::"} = Punctuation:: }
	381	ok "Colon"->isa("Punctuation"),
	382	'isa(foo) when inheriting from ":" which is an alias for foo';
	383	@Colon::ISA = 'Organ:';
	384	bless [], "Organ:";
	385	{
	386	no strict 'refs';
	387	my $life_raft = \%{"Organ:::"};
	388	*{"Organ:::"} = \%Organ::;
	389	ok "Colon"->isa("Organ"),
	390	'isa(foo) when inheriting from "class:" after hash-to-glob assignment';
	391	}
	392	@Colon::ISA = 'O:';
	393	bless [], "O:";
	394	{
	395	no strict 'refs';
	396	my $life_raft = \%{"O:::"};
	397	*{"O:::"} = "Organ::";
	398	ok "Colon"->isa("Organ"),
	399	'isa(foo) when inheriting from "class:" after string-to-glob assignment';
	400	}
	401
6e1b2de7 FC	402	@Bazo::ISA = "Fooo::bar";
	403	sub Fooo::bar::ber { 'baz' }
	404	sub UNIVERSAL::ber { "black sheep" }
	405	Bazo->ber;
	406	local *Fooo:: = \%Baro::;
	407	{
	408	no warnings;
	409	is 'Bazo'->ber, 'black sheep', 'localised *glob=$stashref assignment';
	410	}
3d8812a2 FC	411
	412	# $Stash::{"entries::"} that are not globs.
	413	# These used to crash.
	414	$NotGlob::{"NotGlob::"} = 0; () = $NewNotGlob::NotGlob::;
	415	NewNotGlob:: = NotGlob::;
	416	pass(
	417	"no crash when clobbering sub-'stash' whose parent stash entry is no GV"
	418	);