Add tests for POSIX::Termios->get[iocf]flags().

[perl5.git] / hv.c

diff --git a/hv.c b/hv.c
index 785a306..ccd72fd 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -340,7 +340,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     if (!hv)
        return NULL;
-    if (SvTYPE(hv) == SVTYPEMASK)
+    if (SvTYPE(hv) == (svtype)SVTYPEMASK)
        return NULL;
 
     assert(SvTYPE(hv) == SVt_PVHV);
@@ -1003,7 +1003,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                Safefree(key);
            return NULL;
        }
-       if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+       if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))
+        && !SvIsCOW(HeVAL(entry))) {
            hv_notallowed(k_flags, key, klen,
                            "Attempt to delete readonly key '%"SVf"' from"
                            " a restricted hash");
@@ -1040,12 +1041,18 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    mro_changes = 1;
        }
 
-       if (d_flags & G_DISCARD)
-           sv = NULL;
-       else {
-           sv = sv_2mortal(HeVAL(entry));
-           HeVAL(entry) = &PL_sv_placeholder;
-       }
+       if (d_flags & G_DISCARD) {
+           sv = HeVAL(entry);
+           if (sv) {
+               /* deletion of method from stash */
+               if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv)
+                && HvENAME_get(hv))
+                   mro_method_changed_in(hv);
+               SvREFCNT_dec(sv);
+               sv = NULL;
+           }
+       } else sv = sv_2mortal(HeVAL(entry));
+       HeVAL(entry) = &PL_sv_placeholder;
 
        /*
         * If a restricted hash, rather than really deleting the entry, put
@@ -1053,18 +1060,20 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
         * we can still access via not-really-existing key without raising
         * an error.
         */
-       if (SvREADONLY(hv)) {
-           SvREFCNT_dec(HeVAL(entry));
-           HeVAL(entry) = &PL_sv_placeholder;
+       if (SvREADONLY(hv))
            /* We'll be saving this slot, so the number of allocated keys
             * doesn't go down, but the number placeholders goes up */
            HvPLACEHOLDERS(hv)++;
-       } else {
+       else {
            *oentry = HeNEXT(entry);
            if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
                HvLAZYDEL_on(hv);
-           else
+           else {
+               if (SvOOK(hv) && HvLAZYDEL(hv) &&
+                   entry == HeNEXT(HvAUX(hv)->xhv_eiter))
+                   HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry);
                hv_free_ent(hv, entry);
+           }
            xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */
            if (xhv->xhv_keys == 0)
                HvHASKFLAGS_off(hv);
@@ -1519,7 +1528,8 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 /*
 =for apidoc hv_clear
 
-Clears a hash, making it empty.
+Frees the all the elements of a hash, leaving it empty.
+The XS equivalent of %hash = (). See also L</hv_undef>.
 
 =cut
 */
@@ -1544,7 +1554,8 @@ Perl_hv_clear(pTHX_ HV *hv)
            for (; entry; entry = HeNEXT(entry)) {
                /* not already placeholder */
                if (HeVAL(entry) != &PL_sv_placeholder) {
-                   if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+                   if (HeVAL(entry) && SvREADONLY(HeVAL(entry))
+                    && !SvIsCOW(HeVAL(entry))) {
                        SV* const keysv = hv_iterkeysv(entry);
                        Perl_croak(aTHX_
                                   "Attempt to delete readonly key '%"SVf"' from a restricted hash",
@@ -1622,8 +1633,12 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items)
                *oentry = HeNEXT(entry);
                if (entry == HvEITER_get(hv))
                    HvLAZYDEL_on(hv);
-               else
+               else {
+                   if (SvOOK(hv) && HvLAZYDEL(hv) &&
+                       entry == HeNEXT(HvAUX(hv)->xhv_eiter))
+                       HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry);
                    hv_free_ent(hv, entry);
+               }
 
                if (--items == 0) {
                    /* Finished.  */
@@ -1647,11 +1662,12 @@ STATIC void
 S_hfreeentries(pTHX_ HV *hv)
 {
     STRLEN index = 0;
-    SV* sv;
+    XPVHV * const xhv = (XPVHV*)SvANY(hv);
+    SV *sv;
 
     PERL_ARGS_ASSERT_HFREEENTRIES;
 
-    while ( ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))) ) {
+    while ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))||xhv->xhv_keys) {
        SvREFCNT_dec(sv);
     }
 }
@@ -1660,7 +1676,9 @@ S_hfreeentries(pTHX_ HV *hv)
 /* hfree_next_entry()
  * For use only by S_hfreeentries() and sv_clear().
  * Delete the next available HE from hv and return the associated SV.
- * Returns null on empty hash.
+ * Returns null on empty hash. Nevertheless null is not a reliable
+ * indicator that the hash is empty, as the deleted entry may have a
+ * null value.
  * indexp is a pointer to the current index into HvARRAY. The index should
  * initially be set to 0. hfree_next_entry() may update it.  */
 
@@ -1725,7 +1743,11 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
 /*
 =for apidoc hv_undef
 
-Undefines the hash.
+Undefines the hash.  The XS equivalent of undef(%hash).
+
+As well as freeing all the elements of the hash (like hv_clear()), this
+also frees any auxiliary data and storage associated with the hash.
+See also L</hv_clear>.
 
 =cut
 */
@@ -1791,7 +1813,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
            SvREFCNT_dec(meta->mro_linear_current);
            meta->mro_linear_current = NULL;
        }
-       if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod);
+       SvREFCNT_dec(meta->mro_nextmethod);
        SvREFCNT_dec(meta->isa);
        Safefree(meta);
        aux->xhv_mro_meta = NULL;
@@ -3256,6 +3278,7 @@ to this function: no action occurs and a null pointer is returned.
 struct refcounted_he *
 Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
 {
+    dVAR;
     if (he) {
        HINTS_REFCNT_LOCK;
        he->refcounted_he_refcnt++;
@@ -3264,13 +3287,22 @@ Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
     return he;
 }
 
+/*
+=for apidoc cop_fetch_label
+
+Returns the label attached to a cop.
+The flags pointer may be set to C<SVf_UTF8> or 0.
+
+=cut
+*/
+
 /* pp_entereval is aware that labels are stored with a key ':' at the top of
    the linked list.  */
 const char *
-Perl_fetch_cop_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) {
+Perl_cop_fetch_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) {
     struct refcounted_he *const chain = cop->cop_hints_hash;
 
-    PERL_ARGS_ASSERT_FETCH_COP_LABEL;
+    PERL_ARGS_ASSERT_COP_FETCH_LABEL;
 
     if (!chain)
        return NULL;
@@ -3300,15 +3332,24 @@ Perl_fetch_cop_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) {
     return chain->refcounted_he_data + 1;
 }
 
+/*
+=for apidoc cop_store_label
+
+Save a label into a C<cop_hints_hash>. You need to set flags to C<SVf_UTF8>
+for a utf-8 label.
+
+=cut
+*/
+
 void
-Perl_store_cop_label(pTHX_ COP *const cop, const char *label, STRLEN len,
+Perl_cop_store_label(pTHX_ COP *const cop, const char *label, STRLEN len,
                     U32 flags)
 {
     SV *labelsv;
-    PERL_ARGS_ASSERT_STORE_COP_LABEL;
+    PERL_ARGS_ASSERT_COP_STORE_LABEL;
 
     if (flags & ~(SVf_UTF8))
-       Perl_croak(aTHX_ "panic: store_cop_label illegal flag bits 0x%" UVxf,
+       Perl_croak(aTHX_ "panic: cop_store_label illegal flag bits 0x%" UVxf,
                   (UV)flags);
     labelsv = newSVpvn_flags(label, len, SVs_TEMP);
     if (flags & SVf_UTF8)