Change scalar(%hash) to be the same as 0+keys(%hash)

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.

Author: demerphq

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

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)) {

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

embed.h

@@ -217,6 +217,7 @@
 #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)

ext/Devel-Peek/t/Peek.t

@@ -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);

ext/Hash-Util-FieldHash/t/05_perlhook.t

@@ -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");

ext/Hash-Util/Changes

@@ -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()

ext/Hash-Util/Util.xs

@@ -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

ext/Hash-Util/lib/Hash/Util.pm

@@ -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.

ext/Hash-Util/t/builtin.t

@@ -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");
+
+