This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make delete $package::{ISA} work
authorFather Chrysostomos <sprout@cpan.org>
Sat, 13 Nov 2010 17:41:47 +0000 (09:41 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 13 Nov 2010 17:41:47 +0000 (09:41 -0800)
hv.c
t/mro/basic.t

diff --git a/hv.c b/hv.c
index bc1d4f9..e82b74f 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -987,7 +987,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     entry = *oentry;
     for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
        SV *sv;
-       bool mpm = FALSE;
+       U8 mro_changes = 0; /* 1 = isa; 2 = package moved */
        const char *name = NULL;
        STRLEN namlen;
        HV *stash = NULL;
@@ -1044,7 +1044,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                     gv_fetchsv(namesv, GV_NOADD_NOINIT, SVt_PVGV)
                       == (GV *)sv
                    ) {
-                       mpm = TRUE;
+                       mro_changes = 2;
                        name = SvPV_const(namesv, namlen);
                        namlen -= 2; /* skip trailing :: */
                        /* Hang on to it for a bit. */
@@ -1053,6 +1053,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                        );
                    }
                }
+               else if (klen == 3 && strnEQ(key, "ISA", 3))
+                   mro_changes = 1;
        }
 
        if (d_flags & G_DISCARD)
@@ -1085,7 +1087,9 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                HvHASKFLAGS_off(hv);
        }
 
-       if (mpm) mro_package_moved(NULL, stash, NULL, name, namlen);
+       if (mro_changes == 1) mro_isa_changed_in(hv);
+       else if (mro_changes == 2)
+           mro_package_moved(NULL, stash, NULL, name, namlen);
 
        return sv;
     }
index 1ecfd21..c6f2542 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-BEGIN { require q(./test.pl); } plan(tests => 50);
+BEGIN { require q(./test.pl); } plan(tests => 51);
 
 require mro;
 
@@ -312,3 +312,11 @@ is(eval { MRO_N->testfunc() }, 123);
     ok 'Extra::TSpouse'->isa('Class::Trait::Base'),
      'a isa b after undef *a::ISA and @a::ISA modification';
 }
+
+{
+    # Deleting $package::{ISA}
+    # Broken in 5.10.0; fixed in 5.13.7
+    @Blength::ISA = 'Bladd';
+    delete $Blength::{ISA};
+    ok !Blength->isa("Bladd"), 'delete $package::{ISA}';
+}