perlbug: Allow subjects without whitespace in test mode

[perl5.git] / hv.c

diff --git a/hv.c b/hv.c
index 253cad9..5523475 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1166,8 +1166,73 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                         sv_2mortal((SV *)gv)
                        );
                }
-               else if (klen == 3 && strnEQ(key, "ISA", 3))
+               else if (klen == 3 && strnEQ(key, "ISA", 3) && GvAV(gv)) {
+                    AV *isa = GvAV(gv);
+                    MAGIC *mg = mg_find((SV*)isa, PERL_MAGIC_isa);
+
                    mro_changes = 1;
+                    if (mg) {
+                        if (mg->mg_obj == (SV*)gv) {
+                            /* This is the only stash this ISA was used for.
+                             * The isaelem magic asserts if there's no
+                             * isa magic on the array, so explicitly
+                             * remove the magic on both the array and its
+                             * elements.  @ISA shouldn't be /too/ large.
+                             */
+                            SV **svp, **end;
+                        strip_magic:
+                            svp = AvARRAY(isa);
+                            end = svp + AvFILLp(isa)+1;
+                            while (svp < end) {
+                                if (*svp)
+                                    mg_free_type(*svp, PERL_MAGIC_isaelem);
+                                ++svp;
+                            }
+                            mg_free_type((SV*)GvAV(gv), PERL_MAGIC_isa);
+                        }
+                        else {
+                            /* mg_obj is an array of stashes
+                               Note that the array doesn't keep a reference
+                               count on the stashes.
+                             */
+                            AV *av = (AV*)mg->mg_obj;
+                            SV **svp, **arrayp;
+                            SSize_t index;
+                            SSize_t items;
+
+                            assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
+
+                            /* remove the stash from the magic array */
+                            arrayp = svp = AvARRAY(av);
+                            items = AvFILLp(av) + 1;
+                            if (items == 1) {
+                                assert(*arrayp == (SV *)gv);
+                                mg->mg_obj = NULL;
+                                /* avoid a double free on the last stash */
+                                AvFILLp(av) = -1;
+                                /* The magic isn't MGf_REFCOUNTED, so release
+                                 * the array manually.
+                                 */
+                                SvREFCNT_dec_NN(av);
+                                goto strip_magic;
+                            }
+                            else {
+                                while (items--) {
+                                    if (*svp == (SV*)gv)
+                                        break;
+                                    ++svp;
+                                }
+                                index = svp - arrayp;
+                                assert(index >= 0 && index <= AvFILLp(av));
+                                if (index < AvFILLp(av)) {
+                                    arrayp[index] = arrayp[AvFILLp(av)];
+                                }
+                                arrayp[AvFILLp(av)] = NULL;
+                                --AvFILLp(av);
+                            }
+                        }
+                    }
+                }
        }
 
        sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry));
@@ -1599,8 +1664,8 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry)
 Frees the all the elements of a hash, leaving it empty.
 The XS equivalent of C<%hash = ()>.  See also L</hv_undef>.
 
-If any destructors are triggered as a result, the hv itself may
-be freed.
+See L</av_clear> for a note about the hash possibly being invalid on
+return.
 
 =cut
 */
@@ -1834,10 +1899,8 @@ Undefines the hash.  The XS equivalent of C<undef(%hash)>.
 As well as freeing all the elements of the hash (like C<hv_clear()>), this
 also frees any auxiliary data and storage associated with the hash.
 
-If any destructors are triggered as a result, the hv itself may
-be freed.
-
-See also L</hv_clear>.
+See L</av_clear> for a note about the hash possibly being invalid on
+return.
 
 =cut
 */
@@ -2413,9 +2476,10 @@ Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
                return;
            }
        if (
-           count > 0 && (HEK_UTF8(*namep) || (flags & SVf_UTF8)) 
+           count > 0 && ((HEK_UTF8(*namep) || (flags & SVf_UTF8)) 
                 ? hek_eq_pvn_flags(aTHX_ *namep, name, (I32)len, flags)
                : (HEK_LEN(*namep) == (I32)len && memEQ(HEK_KEY(*namep), name, len))
+            )
        ) {
            aux->xhv_name_count = -count;
        }