In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/48c0e89d40bfde5337dd013112467554427c1279?hp=a149d1180209525972d84fd1a62f488da83e568a>
- Log ----------------------------------------------------------------- commit 48c0e89d40bfde5337dd013112467554427c1279 Author: Yves Orton <[email protected]> Date: Mon Aug 8 20:06:01 2016 +0200 Move hash introspection routines into Hash::Util/Util.xs and out of universal.c M ext/Hash-Util/Util.xs M t/op/coreamp.t M t/op/each.t M t/op/hash.t M t/op/sub_lval.t M universal.c commit e6d22c5d932ba725d7851ee69fe506e478c913db Author: Yves Orton <[email protected]> Date: Mon Aug 8 19:48:01 2016 +0200 s/XS_hash_util_/XS_Hash_Util_/g M universal.c commit 2b9dd39855714297cd65ef6fdb5b7fc530884e1e Author: Yves Orton <[email protected]> Date: Mon Aug 8 19:35:49 2016 +0200 move a declaration so that the Internals:: functions are grouped together M universal.c commit 10f9b9bf77ed09ee67da058d1ba1658a4ce67626 Author: Yves Orton <[email protected]> Date: Mon Aug 8 18:53:20 2016 +0200 move Internals::hv_clear_placeholders() to Hash::Util::_clear_placeholders() There is no reason for this code to be in Internals:: or in universal.c at all, it should only be used from Hash::Util during things like lock_keys(). Moves the function to the XS code in Hash::Util, and renames it as well, along with commented out documentation for what it does. M ext/Hash-Util/Util.xs M ext/Hash-Util/lib/Hash/Util.pm M t/lib/universal.t M t/re/subst.t M universal.c ----------------------------------------------------------------------- Summary of changes: ext/Hash-Util/Util.xs | 16 +++++++-- ext/Hash-Util/lib/Hash/Util.pm | 27 +++++++++++--- t/lib/universal.t | 2 -- t/op/coreamp.t | 1 + t/op/each.t | 1 + t/op/hash.t | 2 +- t/op/sub_lval.t | 1 + t/re/subst.t | 2 +- universal.c | 82 +----------------------------------------- 9 files changed, 42 insertions(+), 92 deletions(-) diff --git a/ext/Hash-Util/Util.xs b/ext/Hash-Util/Util.xs index 01f52bf..db3fb5a 100644 --- a/ext/Hash-Util/Util.xs +++ b/ext/Hash-Util/Util.xs @@ -7,6 +7,16 @@ MODULE = Hash::Util PACKAGE = Hash::Util void +_clear_placeholders(hashref) + HV *hashref + PROTOTYPE: \% + PREINIT: + HV *hv; + CODE: + hv = MUTABLE_HV(hashref); + hv_clear_placeholders(hv); + +void all_keys(hash,keys,placeholder) HV *hash AV *keys @@ -264,7 +274,6 @@ bucket_array(rhv) XSRETURN(0); } -#if PERL_VERSION < 25 SV* bucket_ratio(rhv) SV* rhv @@ -274,7 +283,11 @@ bucket_ratio(rhv) if (SvROK(rhv)) { rhv= SvRV(rhv); if ( SvTYPE(rhv)==SVt_PVHV ) { +#if PERL_VERSION < 25 SV *ret= Perl_hv_scalar(aTHX_ (HV*)rhv); +#else + SV *ret= Perl_hv_bucket_ratio(aTHX_ (HV*)rhv); +#endif ST(0)= ret; XSRETURN(1); } @@ -312,4 +325,3 @@ used_buckets(rhv) XSRETURN_UNDEF; } -#endif diff --git a/ext/Hash-Util/lib/Hash/Util.pm b/ext/Hash-Util/lib/Hash/Util.pm index ff6b3b8..6dbc707 100644 --- a/ext/Hash-Util/lib/Hash/Util.pm +++ b/ext/Hash-Util/lib/Hash/Util.pm @@ -39,9 +39,13 @@ our @EXPORT_OK = qw( used_buckets num_buckets ); -our $VERSION = '0.20'; -require XSLoader; -XSLoader::load(); +BEGIN { + # make sure all our XS routines are available early so their prototypes + # are correctly applied in the following code. + our $VERSION = '0.21'; + require XSLoader; + XSLoader::load(); +} sub import { my $class = shift; @@ -172,7 +176,7 @@ Both routines return a reference to the hash operated on. sub lock_ref_keys { my($hash, @keys) = @_; - Internals::hv_clear_placeholders %$hash; + _clear_placeholders(%$hash); if( @keys ) { my %keys = map { ($_ => 1) } @keys; my %original_keys = map { ($_ => 1) } keys %$hash; @@ -207,6 +211,19 @@ sub unlock_ref_keys { sub lock_keys (\%;@) { lock_ref_keys(@_) } sub unlock_keys (\%) { unlock_ref_keys(@_) } +#=item B<_clear_placeholders> +# +# This function removes any placeholder keys from a hash. See Perl_hv_clear_placeholders() +# in hv.c for what it does exactly. It is currently exposed as XS by universal.c and +# injected into the Hash::Util namespace. +# +# It is not intended for use outside of this module, and may be changed +# or removed without notice or deprecation cycle. +# +#=cut +# +# sub _clear_placeholders {} # just in case someone searches... + =item B<lock_keys_plus> lock_keys_plus(%hash,@additional_keys) @@ -225,7 +242,7 @@ Returns a reference to %hash sub lock_ref_keys_plus { my ($hash,@keys) = @_; my @delete; - Internals::hv_clear_placeholders(%$hash); + _clear_placeholders(%$hash); foreach my $key (@keys) { unless (exists($hash->{$key})) { $hash->{$key}=undef; diff --git a/t/lib/universal.t b/t/lib/universal.t index 5980cad..feb3db9 100644 --- a/t/lib/universal.t +++ b/t/lib/universal.t @@ -14,11 +14,9 @@ for my $arg ('', 'q[]', qw( 1 undef )) { sub tryit { eval shift or warn \$@ } tryit "&Internals::SvREADONLY($arg)"; tryit "&Internals::SvREFCNT($arg)"; -tryit "&Internals::hv_clear_placeholders($arg)"; ---- Usage: Internals::SvREADONLY(SCALAR[, ON]) at (eval 1) line 1. Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT]) at (eval 2) line 1. -Usage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1. ==== } diff --git a/t/op/coreamp.t b/t/op/coreamp.t index cca23f3..5029eab 100644 --- a/t/op/coreamp.t +++ b/t/op/coreamp.t @@ -14,6 +14,7 @@ BEGIN { $^P |= 0x100; } +use Hash::Util; no warnings 'experimental::smartmatch'; sub lis($$;$) { diff --git a/t/op/each.t b/t/op/each.t index 0d342a2..f9adc5c 100644 --- a/t/op/each.t +++ b/t/op/each.t @@ -5,6 +5,7 @@ BEGIN { @INC = '../lib'; require './test.pl'; } +use Hash::Util; plan tests => 59; diff --git a/t/op/hash.t b/t/op/hash.t index 3c083e0..1e5bc6d 100644 --- a/t/op/hash.t +++ b/t/op/hash.t @@ -7,7 +7,7 @@ BEGIN { } use strict; - +use Hash::Util; # This will crash perl if it fails use constant PVBM => 'foo'; diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index c94e9f5..59e286c 100644 --- a/t/op/sub_lval.t +++ b/t/op/sub_lval.t @@ -6,6 +6,7 @@ BEGIN { require './test.pl'; } plan tests=>211; +use Hash::Util; sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary sub b : lvalue { ${\shift} } diff --git a/t/re/subst.t b/t/re/subst.t index 26a78c7..2de1a7b 100644 --- a/t/re/subst.t +++ b/t/re/subst.t @@ -996,7 +996,7 @@ SKIP:{ /e; }; is $locker{key}, '3', 'locking target in $hash{key} =~ s//.../e'; - like $@, qr/^Modification of a read-only value/, 'err msg'; + like $@, qr/^Modification of a read-only value/, 'err msg' . ($@ ? ": $@" : ""); } delete $::{does_not_exist}; # just in case eval { no warnings; $::{does_not_exist}=~s/(?:)/*{"does_not_exist"}; 4/e }; diff --git a/universal.c b/universal.c index 39745d9..e77fad3 100644 --- a/universal.c +++ b/universal.c @@ -627,20 +627,6 @@ XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */ } -XS(XS_Internals_hv_clear_placehold); /* prototype to pass -Wmissing-prototypes */ -XS(XS_Internals_hv_clear_placehold) -{ - dXSARGS; - - if (items != 1 || !SvROK(ST(0))) - croak_xs_usage(cv, "hv"); - else { - HV * const hv = MUTABLE_HV(SvRV(ST(0))); - hv_clear_placeholders(hv); - XSRETURN(0); - } -} - XS(XS_PerlIO_get_layers); /* prototype to pass -Wmissing-prototypes */ XS(XS_PerlIO_get_layers) { @@ -766,68 +752,6 @@ 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) { @@ -1077,13 +1001,9 @@ static const struct xsub_details details[] = { {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL}, {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL}, {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"}, - {"constant::_make_const", XS_constant__make_const, "\\[$@]"}, {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"}, - {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"}, + {"constant::_make_const", XS_constant__make_const, "\\[$@]"}, {"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, ";$"}, -- Perl5 Master Repository
