summaryrefslogtreecommitdiff
path: root/t/mro
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-04-15 22:33:31 -0700
committerFather Chrysostomos <sprout@cpan.org>2011-04-15 22:34:16 -0700
commit1f656fcf060e343780f7a91a2ce567e8a9de9414 (patch)
tree1c24080e8393811be538f104daae330cdb966498 /t/mro
parent2f81e8f3910ca00e129de843e034fb70a0bcc905 (diff)
downloadperl-1f656fcf060e343780f7a91a2ce567e8a9de9414.tar.gz
Followup to 088225f/[perl #88132]: packages ending with :
Commit 088225f was not sufficient to fix the regression. It still exists for packages whose names end with a single colon. I discovered this when trying to determine why RDF::Trine was crashing with 5.14-to-be. In trying to write tests for it, I ended up triggering the same crash that RDF::Trine is having, but in a different way. In the end, it was easier to fix about three or four bugs (depending on how you count them), rather than try to fix only the regression that #88132 deals with (isa caches not updating when packages ending with colons are aliased), as they are all intertwined. The changes are as follows: Concerning the if (!(flags & ~GV_NOADD_MASK)...) statement in gv_stashpvn: Normally, gv_fetchpvn_flags (which it calls and whose retval is assigned to tmpgv) returns NULL if it has not been told to add anything and if the gv requested looks like a stash gv (ends with ::). If the number of colons is odd (foo:::), that code path is bypassed, so gv_stashpvn returns a GV without a hash. So gv_stashpvn tries to used that NULL hash and crashes. It should instead return NULL, to be consistent with the two-colon case. Blindly assigning a name to a stash does not work if the stash has multiple effective names. A call to mro_package_moved is required as well. So what gv_stashpvn was doing was insufficient. The parts of the mro code that check for globs or stash elems that contain stashes by looking for :: at the end of the name now take into account that the name might consist of a single : instead.
Diffstat (limited to 't/mro')
-rw-r--r--t/mro/package_aliases.t50
1 files changed, 46 insertions, 4 deletions
diff --git a/t/mro/package_aliases.t b/t/mro/package_aliases.t
index 3fa3d6cbaf..b08e8edd2f 100644
--- a/t/mro/package_aliases.t
+++ b/t/mro/package_aliases.t
@@ -10,7 +10,7 @@ BEGIN {
use strict;
use warnings;
-plan(tests => 39);
+plan(tests => 52);
{
package New;
@@ -154,13 +154,13 @@ for(
code => '*clone:: = \%outer::',
},
) {
- for my $tail ('inner', 'inner::', 'inner::::') {
+ for my $tail ('inner', 'inner::', 'inner:::', 'inner::::') {
fresh_perl_is
q~
my $tail = shift;
@left::ISA = "outer::$tail";
@right::ISA = "clone::$tail";
- eval "package outer::$tail";
+ bless [], "outer::$tail"; # autovivify the stash
__code__;
@@ -183,7 +183,7 @@ for(
__code__;
- eval qq{package outer::$tail};
+ bless [], "outer::$tail";
print "ok 1", "\n" if left->isa("clone::$tail");
print "ok 2", "\n" if right->isa("outer::$tail");
@@ -358,3 +358,45 @@ is eval { 'Subclass'->womp }, 'clumpren',
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';
+}
+
+