summaryrefslogtreecommitdiff
path: root/universal.c
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2016-06-20 22:51:38 +0200
committerYves Orton <demerphq@gmail.com>2016-06-22 18:21:32 +0200
commit8bf4c4010cc474d4000c2a8c78f6890fa5f1e577 (patch)
treeb12d25aa70138f2dbc13bf1bb49a93fab7e7a4b7 /universal.c
parent6c50b67b99a3df9486896d14dc294825a148a673 (diff)
downloadperl-8bf4c4010cc474d4000c2a8c78f6890fa5f1e577.tar.gz
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.
Diffstat (limited to 'universal.c')
-rw-r--r--universal.c64
1 files changed, 64 insertions, 0 deletions
diff --git a/universal.c b/universal.c
index 31a53cc0b5..0fcaea7701 100644
--- a/universal.c
+++ b/universal.c
@@ -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, ";$"},