One part of pp_pack couldn't correctly handle surprises from UTF-8

[perl5.git] / hv.c

diff --git a/hv.c b/hv.c
index 93853a9..a5336c6 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -72,6 +72,7 @@ S_new_he(pTHX)
     if (!*root)
        S_more_he(aTHX);
     he = *root;
+    assert(he);
     *root = HeNEXT(he);
     UNLOCK_SV_MUTEX;
     return he;
@@ -1592,8 +1593,8 @@ Perl_hv_clear(pTHX_ HV *hv)
                    if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
                        SV* const keysv = hv_iterkeysv(entry);
                        Perl_croak(aTHX_
-       "Attempt to delete readonly key '%"SVf"' from a restricted hash",
-                                  keysv);
+                                  "Attempt to delete readonly key '%"SVf"' from a restricted hash",
+                                  (void*)keysv);
                    }
                    SvREFCNT_dec(HeVAL(entry));
                    HeVAL(entry) = &PL_sv_placeholder;
@@ -2117,7 +2118,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
        iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
        return NULL;
     }
-#ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
+#if defined(DYNAMIC_ENV_FETCH) && !defined(__riscos__)  /* set up %ENV for iteration */
     if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
        prime_env_iter();
 #ifdef VMS
@@ -2563,6 +2564,7 @@ in C<struct refcounted_he *>.
 HV *
 Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
 {
+    dVAR;
     HV *hv = newHV();
     U32 placeholders = 0;
     /* We could chase the chain once to get an idea of the number of keys,
@@ -2684,11 +2686,12 @@ reference count of 1.
 struct refcounted_he *
 Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
                       SV *const key, SV *const value) {
+    dVAR;
     struct refcounted_he *he;
     STRLEN key_len;
     const char *key_p = SvPV_const(key, key_len);
     STRLEN value_len = 0;
-    const char *value_p;
+    const char *value_p = NULL;
     char value_type;
     char flags;
     STRLEN key_offset;
@@ -2784,6 +2787,8 @@ and C<refcounted_he_free> iterates onto the parent node.
 
 void
 Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
+    PERL_UNUSED_CONTEXT;
+
     while (he) {
        struct refcounted_he *copy;
        U32 new_count;
@@ -2818,63 +2823,62 @@ Check that a hash is in an internally consistent state.
 void
 Perl_hv_assert(pTHX_ HV *hv)
 {
-  dVAR;
-  HE* entry;
-  int withflags = 0;
-  int placeholders = 0;
-  int real = 0;
-  int bad = 0;
-  const I32 riter = HvRITER_get(hv);
-  HE *eiter = HvEITER_get(hv);
-
-  (void)hv_iterinit(hv);
-
-  while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
-    /* sanity check the values */
-    if (HeVAL(entry) == &PL_sv_placeholder) {
-      placeholders++;
-    } else {
-      real++;
-    }
-    /* sanity check the keys */
-    if (HeSVKEY(entry)) {
-      /*EMPTY*/ /* Don't know what to check on SV keys.  */
-    } else if (HeKUTF8(entry)) {
-      withflags++;
-       if (HeKWASUTF8(entry)) {
-        PerlIO_printf(Perl_debug_log,
-                      "hash key has both WASUFT8 and UTF8: '%.*s'\n",
-                      (int) HeKLEN(entry),  HeKEY(entry));
-        bad = 1;
-       }
-    } else if (HeKWASUTF8(entry)) {
-      withflags++;
-    }
-  }
-  if (!SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) {
-    if (HvUSEDKEYS(hv) != real) {
-      PerlIO_printf(Perl_debug_log, "Count %d key(s), but hash reports %d\n",
-                   (int) real, (int) HvUSEDKEYS(hv));
-      bad = 1;
-    }
-    if (HvPLACEHOLDERS_get(hv) != placeholders) {
-      PerlIO_printf(Perl_debug_log,
-                   "Count %d placeholder(s), but hash reports %d\n",
-                   (int) placeholders, (int) HvPLACEHOLDERS_get(hv));
-      bad = 1;
-    }
-  }
-  if (withflags && ! HvHASKFLAGS(hv)) {
-    PerlIO_printf(Perl_debug_log,
-                 "Hash has HASKFLAGS off but I count %d key(s) with flags\n",
-                 withflags);
-    bad = 1;
-  }
-  if (bad) {
-    sv_dump((SV *)hv);
-  }
-  HvRITER_set(hv, riter);              /* Restore hash iterator state */
-  HvEITER_set(hv, eiter);
+    dVAR;
+    HE* entry;
+    int withflags = 0;
+    int placeholders = 0;
+    int real = 0;
+    int bad = 0;
+    const I32 riter = HvRITER_get(hv);
+    HE *eiter = HvEITER_get(hv);
+
+    (void)hv_iterinit(hv);
+
+    while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
+       /* sanity check the values */
+       if (HeVAL(entry) == &PL_sv_placeholder)
+           placeholders++;
+       else
+           real++;
+       /* sanity check the keys */
+       if (HeSVKEY(entry)) {
+           NOOP;   /* Don't know what to check on SV keys.  */
+       } else if (HeKUTF8(entry)) {
+           withflags++;
+           if (HeKWASUTF8(entry)) {
+               PerlIO_printf(Perl_debug_log,
+                           "hash key has both WASUFT8 and UTF8: '%.*s'\n",
+                           (int) HeKLEN(entry),  HeKEY(entry));
+               bad = 1;
+           }
+       } else if (HeKWASUTF8(entry))
+           withflags++;
+    }
+    if (!SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) {
+       static const char bad_count[] = "Count %d %s(s), but hash reports %d\n";
+       const int nhashkeys = HvUSEDKEYS(hv);
+       const int nhashplaceholders = HvPLACEHOLDERS_get(hv);
+
+       if (nhashkeys != real) {
+           PerlIO_printf(Perl_debug_log, bad_count, real, "keys", nhashkeys );
+           bad = 1;
+       }
+       if (nhashplaceholders != placeholders) {
+           PerlIO_printf(Perl_debug_log, bad_count, placeholders, "placeholder", nhashplaceholders );
+           bad = 1;
+       }
+    }
+    if (withflags && ! HvHASKFLAGS(hv)) {
+       PerlIO_printf(Perl_debug_log,
+                   "Hash has HASKFLAGS off but I count %d key(s) with flags\n",
+                   withflags);
+       bad = 1;
+    }
+    if (bad) {
+       sv_dump((SV *)hv);
+    }
+    HvRITER_set(hv, riter);            /* Restore hash iterator state */
+    HvEITER_set(hv, eiter);
 }
 
 #endif