Change scalar(%hash) to be the same as 0+keys(%hash)
authorYves Orton <demerphq@gmail.com>
Mon, 20 Jun 2016 20:51:38 +0000 (22:51 +0200)
committerYves Orton <demerphq@gmail.com>
Wed, 22 Jun 2016 16:21:32 +0000 (18:21 +0200)
This subject has a long history see [perl #114576] for more discussion.
https://rt.perl.org/Public/Bug/Display.html?id=114576

There are a variety of reasons we want to change the return signature of
scalar(%hash). One is that it leaks implementation details about our
associative array structure. Another is that it requires us to keep track
of the used buckets in the hash, which we use for no other purpose but
for scalar(%hash). Another is that it is just odd. Almost nothing needs to
know these values. Perhaps debugging, but we have several much better
functions for introspecting the internals of a hash.

By changing the return signature we can remove all the logic related
to maintaining and updating xhv_fill_lazy. This should make hot code
paths a little faster, and maybe save some memory for traversed hashes.

In order to provide some form of backwards compatibility we adds three
new functions to the Hash::Util namespace: bucket_ratio(), num_buckets()
and used_buckets(). These functions are actually implemented in
universal.c, and thus always available even if Hash::Util is not loaded.
This simplifies testing. At the same time Hash::Util contains backwards
compatible code so that the new functions are available from it should
they be needed in older perls.

There are many tests in t/op/hash.t that are more or less obsolete after
this patch as they test that xhv_fill_lazy is correctly set in various
situations. However since we have a backwards compat layer we can just
switch them to use bucket_ratio(%hash) instead of scalar(%hash) and keep
the tests, just in case they are actually testing something not tested
elsewhere.

22 files changed:
MANIFEST
dump.c
embed.fnc
embed.h
ext/Devel-Peek/t/Peek.t
ext/Hash-Util-FieldHash/t/05_perlhook.t
ext/Hash-Util/Changes
ext/Hash-Util/Util.xs
ext/Hash-Util/lib/Hash/Util.pm
ext/Hash-Util/t/builtin.t [new file with mode: 0644]
hv.c
hv.h
pod/perldata.pod
pod/perldelta.pod
pod/perltie.pod
proto.h
sv.c
t/op/coreamp.t
t/op/each.t
t/op/hash.t
t/op/sub_lval.t
universal.c

index 25252df..abafd3b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3858,6 +3858,7 @@ ext/Hash-Util-FieldHash/t/11_hashassign.t Adapted from t/op/hashassign.t
 ext/Hash-Util-FieldHash/t/12_hashwarn.t                Adapted from t/op/hashwarn.t
 ext/Hash-Util/lib/Hash/Util.pm Hash::Util
 ext/Hash-Util/Makefile.PL      Makefile for Hash::Util
+ext/Hash-Util/t/builtin.t      See if Hash::Util builtin exports work as expected
 ext/Hash-Util/t/Util.t         See if Hash::Util works
 ext/Hash-Util/Util.xs          XS bits of Hash::Util
 ext/I18N-Langinfo/Langinfo.pm  I18N::Langinfo
diff --git a/dump.c b/dump.c
index 8e11546..c168162 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1761,15 +1761,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                 } while (++ents <= last);
             }
 
-            if (SvOOK(sv)) {
-                struct xpvhv_aux *const aux = HvAUX(sv);
-                Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf
-                                 " (cached = %"UVuf")\n",
-                                 (UV)count, (UV)aux->xhv_fill_lazy);
-            } else {
-                Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf"\n",
-                                 (UV)count);
-            }
+            Perl_dump_indent(aTHX_ level, file, "  FILL = %"UVuf"\n",
+                             (UV)count);
         }
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)HvMAX(sv));
         if (SvOOK(sv)) {
index e4bfdee..d00f41b 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2774,6 +2774,7 @@ Apod      |void   |hv_assert      |NN HV *hv
 #endif
 
 ApdR   |SV*    |hv_scalar      |NN HV *hv
+ApdRMD |SV*    |hv_bucket_ratio|NN HV *hv
 ApoR   |I32*   |hv_riter_p     |NN HV *hv
 ApoR   |HE**   |hv_eiter_p     |NN HV *hv
 Apo    |void   |hv_riter_set   |NN HV *hv|I32 riter
diff --git a/embed.h b/embed.h
index f32f317..84f647e 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define gv_stashpv(a,b)                Perl_gv_stashpv(aTHX_ a,b)
 #define gv_stashpvn(a,b,c)     Perl_gv_stashpvn(aTHX_ a,b,c)
 #define gv_stashsv(a,b)                Perl_gv_stashsv(aTHX_ a,b)
+#define hv_bucket_ratio(a)     Perl_hv_bucket_ratio(aTHX_ a)
 #define hv_clear(a)            Perl_hv_clear(aTHX_ a)
 #define hv_clear_placeholders(a)       Perl_hv_clear_placeholders(aTHX_ a)
 #define hv_common(a,b,c,d,e,f,g,h)     Perl_hv_common(aTHX_ a,b,c,d,e,f,g,h)
index 56522af..41898fe 100644 (file)
@@ -783,7 +783,7 @@ do_test('ENAME on a stash',
     AUX_FLAGS = 0                               # $] > 5.019008
     ARRAY = $ADDR
     KEYS = 0
-    FILL = 0 \(cached = 0\)
+    FILL = 0
     MAX = 7
     RITER = -1
     EITER = 0x0
@@ -806,7 +806,7 @@ do_test('ENAMEs on a stash',
     AUX_FLAGS = 0                               # $] > 5.019008
     ARRAY = $ADDR
     KEYS = 0
-    FILL = 0 \(cached = 0\)
+    FILL = 0
     MAX = 7
     RITER = -1
     EITER = 0x0
@@ -832,7 +832,7 @@ do_test('ENAMEs on a stash with no NAME',
     AUX_FLAGS = 0                               # $] > 5.019008
     ARRAY = $ADDR
     KEYS = 0
-    FILL = 0 \(cached = 0\)
+    FILL = 0
     MAX = 7
     RITER = -1
     EITER = 0x0
@@ -882,7 +882,7 @@ do_test('small hash after keys',
     ARRAY = $ADDR  \\(0:[67],.*\\)
     hash quality = [0-9.]+%
     KEYS = 2
-    FILL = [12] \\(cached = 0\\)
+    FILL = [12]
     MAX = 7
     RITER = -1
     EITER = 0x0
@@ -912,7 +912,7 @@ do_test('small hash after keys and scalar',
     ARRAY = $ADDR  \\(0:[67],.*\\)
     hash quality = [0-9.]+%
     KEYS = 2
-    FILL = ([12]) \\(cached = \1\\)
+    FILL = ([12])
     MAX = 7
     RITER = -1
     EITER = 0x0
@@ -927,30 +927,6 @@ do_test('small hash after keys and scalar',
       COW_REFCNT = 1
 ){2}');
 
-# This should immediately start with the FILL cached correctly.
-my %large = (0..1999);
-$b = %large;
-do_test('large hash',
-        \%large,
-'SV = $RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\($PADMY,OOK,SHAREKEYS\\)
-    AUX_FLAGS = 0                               # $] > 5.019008
-    ARRAY = $ADDR  \\(0:\d+,.*\\)
-    hash quality = \d+\\.\d+%
-    KEYS = 1000
-    FILL = (\d+) \\(cached = \1\\)
-    MAX = 1023
-    RITER = -1
-    EITER = 0x0
-    RAND = $ADDR
-    Elt .*
-');
-
 # Dump with arrays, hashes, and operator return values
 @array = 1..3;
 do_test('Dump @array', '@array', <<'ARRAY', '', '', 1);
index 61d02ec..ab3d74b 100644 (file)
@@ -103,9 +103,9 @@ sub numbers_first { # Sort helper: All digit entries sort in front of others
     is( $counter, 1, "list each doesn't trigger");
     is( "@x", "abc 123", "the return is correct");
 
-    $x = %h;
+    $x = scalar %h;
     is( $counter, 1, "hash in scalar context doesn't trigger");
-    like( $x, qr!^\d+/\d+$!, "correct result");
+    is( $x, 1, "correct result");
 
     (@x) = %h;
     is( $counter, 1, "hash in list context doesn't trigger");
index ddef72c..beb3f7e 100644 (file)
@@ -1,5 +1,10 @@
 Revision history for Perl extension Hash::Util.
 
+0.20
+    Add bucket_ratio, num_buckets, used_buckets as a back-compat
+    shin for 5.25 where we remove the bucket data from scalar(%hash)
+    by making it return the count of keys by default.
+
 0.17
     Add bucket_stats_formatted() as utility method to Hash::Util
     Bug fixes to hash_stats()
index 9481dc7..01f52bf 100644 (file)
@@ -263,3 +263,53 @@ bucket_array(rhv)
     }
     XSRETURN(0);
 }
+
+#if PERL_VERSION < 25
+SV*
+bucket_ratio(rhv)
+        SV* rhv
+    PROTOTYPE: \%
+    PPCODE:
+{
+    if (SvROK(rhv)) {
+        rhv= SvRV(rhv);
+        if ( SvTYPE(rhv)==SVt_PVHV ) {
+            SV *ret= Perl_hv_scalar(aTHX_ (HV*)rhv);
+            ST(0)= ret;
+            XSRETURN(1);
+        }
+    }
+    XSRETURN_UNDEF;
+}
+
+SV*
+num_buckets(rhv)
+        SV* rhv
+    PROTOTYPE: \%
+    PPCODE:
+{
+    if (SvROK(rhv)) {
+        rhv= SvRV(rhv);
+        if ( SvTYPE(rhv)==SVt_PVHV ) {
+            XSRETURN_UV(HvMAX((HV*)rhv)+1);
+        }
+    }
+    XSRETURN_UNDEF;
+}
+
+SV*
+used_buckets(rhv)
+        SV* rhv
+    PROTOTYPE: \%
+    PPCODE:
+{
+    if (SvROK(rhv)) {
+        rhv= SvRV(rhv);
+        if ( SvTYPE(rhv)==SVt_PVHV ) {
+            XSRETURN_UV(HvFILL((HV*)rhv));
+        }
+    }
+    XSRETURN_UNDEF;
+}
+
+#endif
index a947b9a..ff6b3b8 100644 (file)
@@ -34,8 +34,12 @@ our @EXPORT_OK  = qw(
                      lock_hashref_recurse unlock_hashref_recurse
 
                      hash_traversal_mask
+
+                     bucket_ratio
+                     used_buckets
+                     num_buckets
                     );
-our $VERSION = '0.19';
+our $VERSION = '0.20';
 require XSLoader;
 XSLoader::load();
 
@@ -727,6 +731,29 @@ order. B<Note> that this does B<not> guarantee that B<two> hashes will produce
 the same key order for the same hash seed and traversal mask, items that
 collide into one bucket may have different orders regardless of this setting.
 
+=item B<bucket_ratio>
+
+This function behaves the same way that scalar(%hash) behaved prior to
+Perl 5.25. Specifically if the hash is tied, then it calls the SCALAR tied
+hash method, if untied then if the hash is empty it return 0, otherwise it
+returns a string containing the number of used buckets in the hash,
+followed by a slash, followed by the total number of buckets in the hash.
+
+    my %hash=("foo"=>1);
+    print Hash::Util::bucket_ratio(%hash); # prints "1/8"
+
+=item B<used_buckets>
+
+This function returns the count of used buckets in the hash. It is expensive
+to calculate and the value is NOT cached, so avoid use of this function
+in production code.
+
+=item B<num_buckets>
+
+This function returns the total number of buckets the hash holds, or would
+hold if the array were created. (When a hash is freshly created the array
+may not be allocated even though this value will be non-zero.)
+
 =back
 
 =head2 Operating on references to hashes.
diff --git a/ext/Hash-Util/t/builtin.t b/ext/Hash-Util/t/builtin.t
new file mode 100644 (file)
index 0000000..3654c9b
--- /dev/null
@@ -0,0 +1,38 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use Test::More;
+
+my @Exported_Funcs;
+BEGIN {
+    @Exported_Funcs = qw( bucket_ratio num_buckets used_buckets );
+    plan tests => 13 + @Exported_Funcs;
+    use_ok 'Hash::Util', @Exported_Funcs;
+}
+foreach my $func (@Exported_Funcs) {
+    can_ok __PACKAGE__, $func;
+}
+
+my %hash;
+
+is(bucket_ratio(%hash), 0, "Empty hash has no bucket_ratio");
+is(num_buckets(%hash), 8, "Empty hash should have eight buckets");
+is(used_buckets(%hash), 0, "Empty hash should have no used buckets");
+
+$hash{1}= 1;
+is(bucket_ratio(%hash), "1/8", "hash has expected bucket_ratio");
+is(num_buckets(%hash), 8, "hash should have eight buckets");
+is(used_buckets(%hash), 1, "hash should have one used buckets");
+
+$hash{$_}= $_ for 2..7;
+
+like(bucket_ratio(%hash), qr!/8!, "hash has expected number of buckets in bucket_ratio");
+is(num_buckets(%hash), 8, "hash should have eight buckets");
+cmp_ok(used_buckets(%hash), "<", 8, "hash should have one used buckets");
+
+$hash{8}= 8;
+like(bucket_ratio(%hash), qr!/16!, "hash has expected number of buckets in bucket_ratio");
+is(num_buckets(%hash), 16, "hash should have sixteen buckets");
+cmp_ok(used_buckets(%hash), "<=", 8, "hash should have at most 8 used buckets");
+
+
diff --git a/hv.c b/hv.c
index 5523475..3b2523b 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -829,13 +829,6 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
     HeVAL(entry) = val;
 
-    if (!*oentry && SvOOK(hv)) {
-        /* initial entry, and aux struct present.  */
-        struct xpvhv_aux *const aux = HvAUX(hv);
-        if (aux->xhv_fill_lazy)
-            ++aux->xhv_fill_lazy;
-    }
-
 #ifdef PERL_HASH_RANDOMIZE_KEYS
     /* This logic semi-randomizes the insert order in a bucket.
      * Either we insert into the top, or the slot below the top,
@@ -937,8 +930,14 @@ S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store)
 /*
 =for apidoc hv_scalar
 
-Evaluates the hash in scalar context and returns the result.  Handles magic
-when the hash is tied.
+Evaluates the hash in scalar context and returns the result.
+
+When the hash is tied dispatches through to the SCALAR method,
+otherwise returns a mortal SV containing the number of keys
+in the hash.
+
+Note, prior to 5.25 this function returned what is now
+returned by the hv_bucket_ratio() function.
 
 =cut
 */
@@ -957,7 +956,41 @@ Perl_hv_scalar(pTHX_ HV *hv)
     }
 
     sv = sv_newmortal();
-    if (HvTOTALKEYS((const HV *)hv)) 
+    sv_setuv(sv, HvUSEDKEYS(hv));
+
+    return sv;
+}
+
+/*
+=for apidoc Perl_hv_bucket_ratio
+
+If the hash is tied dispatches through to the SCALAR tied method,
+otherwise if the hash contains no keys returns 0, otherwise returns
+a mortal sv containing a string specifying the number of used buckets,
+followed by a slash, followed by the number of available buckets.
+
+This function is expensive, it must scan all of the buckets
+to determine which are used, and the count is NOT cached.
+In a large hash this could be a lot of buckets.
+
+=cut
+*/
+
+SV *
+Perl_hv_bucket_ratio(pTHX_ HV *hv)
+{
+    SV *sv;
+
+    PERL_ARGS_ASSERT_HV_BUCKET_RATIO;
+
+    if (SvRMAGICAL(hv)) {
+        MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_tied);
+        if (mg)
+            return magic_scalarpack(hv, mg);
+    }
+
+    sv = sv_newmortal();
+    if (HvUSEDKEYS((const HV *)hv))
         Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
                 (long)HvFILL(hv), (long)HvMAX(hv) + 1);
     else
@@ -1256,12 +1289,6 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            HvPLACEHOLDERS(hv)++;
        else {
            *oentry = HeNEXT(entry);
-            if(!*first_entry && SvOOK(hv)) {
-                /* removed last entry, and aux struct present.  */
-                struct xpvhv_aux *const aux = HvAUX(hv);
-                if (aux->xhv_fill_lazy)
-                    --aux->xhv_fill_lazy;
-            }
            if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
                HvLAZYDEL_on(hv);
            else {
@@ -1353,10 +1380,6 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize)
 #ifdef PERL_HASH_RANDOMIZE_KEYS
             dest->xhv_rand = (U32)PL_hash_rand_bits;
 #endif
-            /* For now, just reset the lazy fill counter.
-               It would be possible to update the counter in the code below
-               instead.  */
-            dest->xhv_fill_lazy = 0;
         } else {
             /* no existing aux structure, but we allocated space for one
              * so initialize it properly. This unrolls hv_auxinit() a bit,
@@ -1852,12 +1875,6 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
             iter->xhv_last_rand = iter->xhv_rand;
 #endif
         }
-        /* Reset any cached HvFILL() to "unknown".  It's unlikely that anyone
-           will actually call HvFILL() on a hash under destruction, so it
-           seems pointless attempting to track the number of keys remaining.
-           But if they do, we want to reset it again.  */
-        if (iter->xhv_fill_lazy)
-            iter->xhv_fill_lazy = 0;
     }
 
     if (!((XPVHV*)SvANY(hv))->xhv_keys)
@@ -2002,17 +2019,15 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
 /*
 =for apidoc hv_fill
 
-Returns the number of hash buckets that
-happen to be in use.  This function is
-wrapped by the macro C<HvFILL>.
+Returns the number of hash buckets that happen to be in use.
+
+This function is wrapped by the macro C<HvFILL>.
 
-Previously this value was always stored in the HV structure, which created an
-overhead on every hash (and pretty much every object) for something that was
-rarely used.  Now we calculate it on demand the first
-time that it is needed, and cache it if that calculation
-is going to be costly to repeat.  The cached
-value is updated by insertions and deletions, but (currently) discarded if
-the hash is split.
+As of perl 5.25 this function is used only for debugging
+purposes, and the number of used hash buckets is not
+in any way cached, thus this function can be costly
+to execute as it must iterate over all the buckets in the
+hash.
 
 =cut
 */
@@ -2022,7 +2037,6 @@ Perl_hv_fill(pTHX_ HV *const hv)
 {
     STRLEN count = 0;
     HE **ents = HvARRAY(hv);
-    struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : NULL;
 
     PERL_ARGS_ASSERT_HV_FILL;
 
@@ -2031,12 +2045,12 @@ Perl_hv_fill(pTHX_ HV *const hv)
     if (HvTOTALKEYS(hv) < 2)
         return HvTOTALKEYS(hv);
 
-#ifndef DEBUGGING
-    if (aux && aux->xhv_fill_lazy)
-        return aux->xhv_fill_lazy;
-#endif
-
     if (ents) {
+        /* I wonder why we count down here...
+         * Is it some micro-optimisation?
+         * I would have thought counting up was better.
+         * - Yves
+         */
        HE *const *const last = ents + HvMAX(hv);
        count = last + 1 - ents;
 
@@ -2045,16 +2059,6 @@ Perl_hv_fill(pTHX_ HV *const hv)
                --count;
        } while (++ents <= last);
     }
-    if (aux) {
-#ifdef DEBUGGING
-        if (aux->xhv_fill_lazy)
-            assert(aux->xhv_fill_lazy == count);
-#endif
-        aux->xhv_fill_lazy = count;
-    } else if (HvMAX(hv) >= HV_FILL_THRESHOLD) {
-        aux = hv_auxinit(hv);
-        aux->xhv_fill_lazy = count;
-    }        
     return count;
 }
 
@@ -2099,7 +2103,6 @@ S_hv_auxinit_internal(struct xpvhv_aux *iter) {
 #ifdef PERL_HASH_RANDOMIZE_KEYS
     iter->xhv_last_rand = iter->xhv_rand;
 #endif
-    iter->xhv_fill_lazy = 0;
     iter->xhv_name_u.xhvnameu_name = 0;
     iter->xhv_name_count = 0;
     iter->xhv_backreferences = 0;
@@ -2181,7 +2184,7 @@ Perl_hv_iterinit(pTHX_ HV *hv)
        hv_auxinit(hv);
     }
 
-    /* used to be xhv->xhv_fill before 5.004_65 */
+    /* note this includes placeholders! */
     return HvTOTALKEYS(hv);
 }
 
diff --git a/hv.h b/hv.h
index b97b224..0e773f2 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -119,7 +119,6 @@ struct xpvhv_aux {
     U32         xhv_last_rand;  /* last random value for hash traversal,
                                    used to detect each() after insert for warnings */
 #endif
-    U32         xhv_fill_lazy;
     U32         xhv_aux_flags;      /* assorted extra flags */
 };
 
index 66bb206..0ff6534 100644 (file)
@@ -400,17 +400,24 @@ leave nothing to doubt:
     $element_count = scalar(@whatever);
 
 If you evaluate a hash in scalar context, it returns false if the
-hash is empty.  If there are any key/value pairs, it returns true;
-more precisely, the value returned is a string consisting of the
+hash is empty.  If there are any key/value pairs, it returns true.
+A more precise definition is version dependent.
+
+Prior to Perl 5.25 the value returned was a string consisting of the
 number of used buckets and the number of allocated buckets, separated
 by a slash.  This is pretty much useful only to find out whether
 Perl's internal hashing algorithm is performing poorly on your data
 set.  For example, you stick 10,000 things in a hash, but evaluating
 %HASH in scalar context reveals C<"1/16">, which means only one out
 of sixteen buckets has been touched, and presumably contains all
-10,000 of your items.  This isn't supposed to happen.  If a tied hash
-is evaluated in scalar context, the C<SCALAR> method is called (with a
-fallback to C<FIRSTKEY>).
+10,000 of your items.  This isn't supposed to happen.
+
+As of Perl 5.25 the return was changed to be the count of keys in the
+hash. If you need access to the old behavior you can use
+C<Hash::Util::bucket_ratio()> instead.
+
+If a tied hash is evaluated in scalar context, the C<SCALAR> method is
+called (with a fallback to C<FIRSTKEY>).
 X<hash, scalar context> X<hash, bucket> X<bucket>
 
 You can preallocate space for a hash by assigning to the keys() function.
index 7c05104..53d839a 100644 (file)
@@ -100,6 +100,16 @@ XXX
 
 =back
 
+=head2 C<scalar(%hash)> return signature changed
+
+The value returned for C<scalar(%hash)> will no longer show information
+about the buckets allocated in the hash. It will simply return the count
+of used keys. It is thus equivalent to C<0+keys(%hash)>.
+
+A form of backwards compatibility is provided via C<Hash::Util::bucket_ratio()>
+which provides the same behavior as scalar(%hash) provided prior to
+Perl 5.25.
+
 =head1 Modules and Pragmata
 
 XXX All changes to installed files in F<cpan/>, F<dist/>, F<ext/> and F<lib/>
index 7b89f57..87a2126 100644 (file)
@@ -828,6 +828,11 @@ referenced by C<$self-E<gt>{LIST}>:
        return scalar %{ $self->{LIST} }
     }
 
+NOTE: In perl 5.25 the behavior of scalar %hash on an untied hash changed
+to return the count of keys. Prior to this it returned a string containing
+information about the bucket setup of the hash. See
+L<Hash::Util/bucket_ratio> for a backwards compatibility path.
+
 =item UNTIE this
 X<UNTIE>
 
@@ -1196,10 +1201,11 @@ modules L<Tie::Scalar>, L<Tie::Array>, L<Tie::Hash>, or L<Tie::Handle>.
 
 =head1 BUGS
 
-The bucket usage information provided by C<scalar(%hash)> is not
+The normal return provided by C<scalar(%hash)> is not
 available.  What this means is that using %tied_hash in boolean
 context doesn't work right (currently this always tests false,
 regardless of whether the hash is empty or hash elements).
+[ This paragraph needs review in light of changes in 5.25 ]
 
 Localizing tied arrays or hashes does not work.  After exiting the
 scope the arrays or the hashes are not restored.
diff --git a/proto.h b/proto.h
index 369da2c..86e9480 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1117,6 +1117,12 @@ PERL_CALLCONV void       Perl_gv_try_downgrade(pTHX_ GV* gv);
 PERL_CALLCONV AV**     Perl_hv_backreferences_p(pTHX_ HV *hv);
 #define PERL_ARGS_ASSERT_HV_BACKREFERENCES_P   \
        assert(hv)
+PERL_CALLCONV SV*      Perl_hv_bucket_ratio(pTHX_ HV *hv)
+                       __attribute__deprecated__
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_HV_BUCKET_RATIO       \
+       assert(hv)
+
 PERL_CALLCONV void     Perl_hv_clear(pTHX_ HV *hv);
 PERL_CALLCONV void     Perl_hv_clear_placeholders(pTHX_ HV *hv);
 #define PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS \
diff --git a/sv.c b/sv.c
index b0fdd15..cbdb28e 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13860,7 +13860,6 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                        }
                        daux->xhv_name_count = saux->xhv_name_count;
 
-                       daux->xhv_fill_lazy = saux->xhv_fill_lazy;
                        daux->xhv_aux_flags = saux->xhv_aux_flags;
 #ifdef PERL_HASH_RANDOMIZE_KEYS
                        daux->xhv_rand = saux->xhv_rand;
index e35f4f3..cca23f3 100644 (file)
@@ -634,7 +634,7 @@ lis [&mykeys([ 1..4 ])], [0..3], '&mykeys(\@array) in list cx';
 {
   my %h = 1..2;
   &mykeys(\%h) = 1024;
-  like %h, qr|/1024\z|, '&mykeys = ...';
+  like Hash::Util::bucket_ratio(%h), qr|/1024\z|, '&mykeys = changed number of buckets allocated';
   eval { (&mykeys(\%h)) = 1025; };
   like $@, qr/^Can't modify keys in list assignment at /;
 }
index b33fbac..0d342a2 100644 (file)
@@ -60,19 +60,19 @@ is ($i, 30, "each count");
 @keys = ('blurfl', keys(%h), 'dyick');
 is ($#keys, 31, "added a key");
 
-$size = ((split('/',scalar %h))[1]);
+$size = Hash::Util::num_buckets(%h);
 keys %h = $size * 5;
-$newsize = ((split('/',scalar %h))[1]);
+$newsize = Hash::Util::num_buckets(%h);
 is ($newsize, $size * 8, "resize");
 keys %h = 1;
-$size = ((split('/',scalar %h))[1]);
+$size = Hash::Util::num_buckets(%h);
 is ($size, $newsize, "same size");
 %h = (1,1);
-$size = ((split('/',scalar %h))[1]);
+$size = Hash::Util::num_buckets(%h);
 is ($size, $newsize, "still same size");
 undef %h;
 %h = (1,1);
-$size = ((split('/',scalar %h))[1]);
+$size = Hash::Util::num_buckets(%h);
 is ($size, 8, "size 8");
 
 # test scalar each
@@ -98,11 +98,13 @@ $total = 0;
 $total += $key while $key = each %hash;
 is ($total, 100, "test values keys resets iterator");
 
-$size = (split('/', scalar %hash))[1];
+$size = Hash::Util::num_buckets(%hash);
 keys(%hash) = $size / 2;
-is ($size, (split('/', scalar %hash))[1]);
+is ($size, Hash::Util::num_buckets(%hash),
+    "assign to keys does not shrink hash bucket array");
 keys(%hash) = $size + 100;
-isnt ($size, (split('/', scalar %hash))[1]);
+isnt ($size, Hash::Util::num_buckets(%hash),
+    "assignment to keys of a number not large enough does not change size");
 
 is (keys(%hash), 10, "keys (%hash)");
 
@@ -191,14 +193,14 @@ for my $k (qw(each keys values)) {
     my ($k2,$v2)=each(%foo);
     my $rest=0;
     while (each(%foo)) {$rest++};
-    is($yes,1,"if(%foo) was true");
-    isnt($k1,$k2,"if(%foo) didnt mess with each (key)");
-    isnt($v1,$v2,"if(%foo) didnt mess with each (value)");
-    is($rest,3,"Got the expect number of keys");
+    is($yes,1,"if(%foo) was true - my");
+    isnt($k1,$k2,"if(%foo) didnt mess with each (key) - my");
+    isnt($v1,$v2,"if(%foo) didnt mess with each (value) - my");
+    is($rest,3,"Got the expected number of keys - my");
     my $hsv=1 && %foo;
-    like($hsv,qr[/],"Got bucket stats from %foo in scalar assignment context");
+    is($hsv,$count,"Got the count of keys from %foo in scalar assignment context - my");
     my @arr=%foo&&%foo;
-    is(@arr,10,"Got expected number of elements in list context");
+    is(@arr,10,"Got expected number of elements in list context - my");
 }    
 {
     our %foo=(1..10);
@@ -210,14 +212,14 @@ for my $k (qw(each keys values)) {
     my ($k2,$v2)=each(%foo);
     my $rest=0;
     while (each(%foo)) {$rest++};
-    is($yes,1,"if(%foo) was true");
-    isnt($k1,$k2,"if(%foo) didnt mess with each (key)");
-    isnt($v1,$v2,"if(%foo) didnt mess with each (value)");
-    is($rest,3,"Got the expect number of keys");
+    is($yes,1,"if(%foo) was true - our");
+    isnt($k1,$k2,"if(%foo) didnt mess with each (key) - our");
+    isnt($v1,$v2,"if(%foo) didnt mess with each (value) - our");
+    is($rest,3,"Got the expected number of keys - our");
     my $hsv=1 && %foo;
-    like($hsv,qr[/],"Got bucket stats from %foo in scalar assignment context");
+    is($hsv,$count,"Got the count of keys from %foo in scalar assignment context - our");
     my @arr=%foo&&%foo;
-    is(@arr,10,"Got expected number of elements in list context");
+    is(@arr,10,"Got expected number of elements in list context - our");
 }    
 {
     # make sure a deleted active iterator gets freed timely, even if the
index b4d6c25..3c083e0 100644 (file)
@@ -127,10 +127,19 @@ sub validate_hash {
   my ($desc, $h) = @_;
   local $::Level = $::Level + 1;
 
-  my $scalar = %$h;
+  # test that scalar(%hash) works as expected, which as of perl 5.25 is
+  # the same as 0+keys %hash;
+  my $scalar= scalar %$h;
+  my $count= 0+keys %$h;
+
+  is($scalar, $count, "$desc scalar() should be the same as 0+keys() as of perl 5.25");
+
+  # back compat tests, via Hash::Util::bucket_ratio();
+  my $ratio = Hash::Util::bucket_ratio(%$h);
   my $expect = qr!\A(\d+)/(\d+)\z!;
-  like($scalar, $expect, "$desc in scalar context matches pattern");
-  my ($used, $total) = $scalar =~ $expect;
+  like($ratio, $expect, "$desc bucket_ratio matches pattern");
+  my ($used, $total)= (0,0);
+  ($used, $total)= ($1,$2) if $ratio =~ /$expect/;
   cmp_ok($total, '>', 0, "$desc has >0 array size ($total)");
   cmp_ok($used, '>', 0, "$desc uses >0 heads ($used)");
   cmp_ok($used, '<=', $total,
index dd0805f..eb33027 100644 (file)
@@ -552,7 +552,7 @@ is("@p", "1 8");
 sub keeze : lvalue { keys %__ }
 %__ = ("a","b");
 keeze = 64;
-is scalar %__, '1/64', 'keys assignment through lvalue sub';
+is Hash::Util::bucket_ratio(%__), '1/64', 'keys assignment through lvalue sub';
 eval { (keeze) = 64 };
 like $@, qr/^Can't modify keys in list assignment at /,
   'list assignment to keys through lv sub is forbidden';
index 31a53cc..0fcaea7 100644 (file)
@@ -766,6 +766,67 @@ XS(XS_PerlIO_get_layers)
     XSRETURN(0);
 }
 
+XS(XS_hash_util_bucket_ratio); /* prototype to pass -Wmissing-prototypes */
+XS(XS_hash_util_bucket_ratio)
+{
+    dXSARGS;
+    SV *rhv;
+    PERL_UNUSED_VAR(cv);
+
+    if (items != 1)
+        croak_xs_usage(cv, "hv");
+
+    rhv= ST(0);
+    if (SvROK(rhv)) {
+        rhv= SvRV(rhv);
+        if ( SvTYPE(rhv)==SVt_PVHV ) {
+            SV *ret= Perl_hv_bucket_ratio(aTHX_ (HV*)rhv);
+            ST(0)= ret;
+            XSRETURN(1);
+        }
+    }
+    XSRETURN_UNDEF;
+}
+
+XS(XS_hash_util_num_buckets); /* prototype to pass -Wmissing-prototypes */
+XS(XS_hash_util_num_buckets)
+{
+    dXSARGS;
+    SV *rhv;
+    PERL_UNUSED_VAR(cv);
+
+    if (items != 1)
+        croak_xs_usage(cv, "hv");
+
+    rhv= ST(0);
+    if (SvROK(rhv)) {
+        rhv= SvRV(rhv);
+        if ( SvTYPE(rhv)==SVt_PVHV ) {
+            XSRETURN_UV(HvMAX((HV*)rhv)+1);
+        }
+    }
+    XSRETURN_UNDEF;
+}
+
+XS(XS_hash_util_used_buckets); /* prototype to pass -Wmissing-prototypes */
+XS(XS_hash_util_used_buckets)
+{
+    dXSARGS;
+    SV *rhv;
+    PERL_UNUSED_VAR(cv);
+
+    if (items != 1)
+        croak_xs_usage(cv, "hv");
+
+    rhv= ST(0);
+    if (SvROK(rhv)) {
+        rhv= SvRV(rhv);
+        if ( SvTYPE(rhv)==SVt_PVHV ) {
+            XSRETURN_UV(HvFILL((HV*)rhv));
+        }
+    }
+    XSRETURN_UNDEF;
+}
 
 XS(XS_re_is_regexp); /* prototype to pass -Wmissing-prototypes */
 XS(XS_re_is_regexp)
@@ -1023,6 +1084,9 @@ static const struct xsub_details details[] = {
     {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
     {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
     {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
+    {"Hash::Util::bucket_ratio", XS_hash_util_bucket_ratio, "\\%"},
+    {"Hash::Util::num_buckets", XS_hash_util_num_buckets, "\\%"},
+    {"Hash::Util::used_buckets", XS_hash_util_used_buckets, "\\%"},
     {"re::is_regexp", XS_re_is_regexp, "$"},
     {"re::regname", XS_re_regname, ";$$"},
     {"re::regnames", XS_re_regnames, ";$"},