diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-04-15 22:33:31 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-04-15 22:34:16 -0700 |
commit | 1f656fcf060e343780f7a91a2ce567e8a9de9414 (patch) | |
tree | 1c24080e8393811be538f104daae330cdb966498 /t/mro | |
parent | 2f81e8f3910ca00e129de843e034fb70a0bcc905 (diff) | |
download | perl-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.t | 50 |
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'; +} + + |