This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix *ISA = *glob_without_array
authorFather Chrysostomos <sprout@cpan.org>
Fri, 13 Jul 2012 00:35:37 +0000 (17:35 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 13 Jul 2012 00:35:37 +0000 (17:35 -0700)
I broke this in 5.14 with commit 6624142a.

In trying to make *ISA = *Other::ISA work, I added logic to make
@Other::ISA’s existing magic now point to *ISA’s stash.  I skipped
that logic if *Other::ISA did not contain an array.  But in so
doing, I inadvertently skipped the call to mro_isa_changed_in at the
same time.

sv.c
t/mro/basic.t

diff --git a/sv.c b/sv.c
index dd78927..9caaa4d 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3723,7 +3723,6 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
          /* The stash may have been detached from the symbol table, so
             check its name. */
          && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
-         && GvAV((const GV *)sstr)
         )
             mro_changes = 2;
         else {
@@ -3758,6 +3757,7 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
        }
     GvMULTI_on(dstr);
     if(mro_changes == 2) {
+      if (GvAV((const GV *)sstr)) {
        MAGIC *mg;
        SV * const sref = (SV *)GvAV((const GV *)dstr);
        if (SvSMAGICAL(sref) && (mg = mg_find(sref, PERL_MAGIC_isa))) {
@@ -3769,7 +3769,8 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
            av_push((AV *)mg->mg_obj, SvREFCNT_inc_simple_NN(dstr));
        }
        else sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
-       mro_isa_changed_in(GvSTASH(dstr));
+      }
+      mro_isa_changed_in(GvSTASH(dstr));
     }
     else if(mro_changes == 3) {
        HV * const stash = GvHV(dstr);
index 9955b81..e1a4dbf 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-BEGIN { require q(./test.pl); } plan(tests => 52);
+BEGIN { require q(./test.pl); } plan(tests => 53);
 
 require mro;
 
@@ -328,3 +328,13 @@ is(eval { MRO_N->testfunc() }, 123);
     undef %Thwit::;
     ok !Thrext->isa('Sile'), 'undef %package:: updates subclasses';
 }
+
+{
+    # Obliterating @ISA via glob assignment
+    # Broken in 5.14.0; fixed in 5.17.2
+    @Gwythaint::ISA = "Fantastic::Creature";
+    undef *This_glob_haD_better_not_exist; # paranoia; must have no array
+    *Gwythaint::ISA = *This_glob_haD_better_not_exist;
+    ok !Gwythaint->isa("Fantastic::Creature"),
+       'obliterating @ISA via glob assignment';
+}