mirror of
https://github.com/Perl/perl5.git
synced 2026-01-27 01:44:43 +00:00
S_clear_placeholders() should call HvHASKFLAGS_off() if no keys remain.
This isn't essential - HvHASKFLAGS() set when there are no keys with flags
merely disables some potential optimisations. (The other way round - not
being set when keys have flags would be a bug).
This is a regression I introduced in Feb 2004 with commit d36773897a6f30fc:
hv_clear_placeholders now manipulates the linked lists directly, rather
than using the iterator interface and calling hv_delete
This will allow hv_delete to be simplified to remove most of the
special casing related to placeholders.
However several people have looked at the code since then and no-one has
realised that with the logic as-was, this call had to be unreachable.
Also avoid calling HvPLACEHOLDERS_get() twice - each caller has already
done this, so pass the value in.
This commit is contained in:
parent
f1c1602aa0
commit
c23e25b4e6
1
MANIFEST
1
MANIFEST
@ -5878,6 +5878,7 @@ t/op/grep.t See if grep() and map() work
|
||||
t/op/groups.t See if $( works
|
||||
t/op/gv.t See if typeglobs work
|
||||
t/op/hash.t See if the complexity attackers are repelled
|
||||
t/op/hash-clear-placeholders.t FIXME
|
||||
t/op/hash-rt85026.t See if hash iteration/deletion works
|
||||
t/op/hashassign.t See if hash assignments work
|
||||
t/op/hashwarn.t See if warnings for bad hash assignments work
|
||||
|
||||
15
hv.c
15
hv.c
@ -1882,14 +1882,14 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
|
||||
}
|
||||
|
||||
static void
|
||||
S_clear_placeholders(pTHX_ HV *hv, U32 items)
|
||||
S_clear_placeholders(pTHX_ HV *hv, const U32 placeholders)
|
||||
{
|
||||
I32 i;
|
||||
U32 to_find = placeholders;
|
||||
|
||||
PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS;
|
||||
|
||||
if (items == 0)
|
||||
return;
|
||||
assert(to_find);
|
||||
|
||||
i = HvMAX(hv);
|
||||
do {
|
||||
@ -1909,12 +1909,10 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items)
|
||||
hv_free_ent(hv, entry);
|
||||
}
|
||||
|
||||
if (--items == 0) {
|
||||
if (--to_find == 0) {
|
||||
/* Finished. */
|
||||
I32 placeholders = HvPLACEHOLDERS_get(hv);
|
||||
HvTOTALKEYS(hv) -= (IV)placeholders;
|
||||
/* HvUSEDKEYS expanded */
|
||||
if ((HvTOTALKEYS(hv) - placeholders) == 0)
|
||||
if (HvTOTALKEYS(hv) == 0)
|
||||
HvHASKFLAGS_off(hv);
|
||||
HvPLACEHOLDERS_set(hv, 0);
|
||||
return;
|
||||
@ -1925,7 +1923,7 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items)
|
||||
}
|
||||
} while (--i >= 0);
|
||||
/* You can't get here, hence assertion should always fail. */
|
||||
assert (items == 0);
|
||||
assert (to_find == 0);
|
||||
NOT_REACHED; /* NOTREACHED */
|
||||
}
|
||||
|
||||
@ -3343,7 +3341,6 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags)
|
||||
|
||||
if (placeholders) {
|
||||
clear_placeholders(hv, placeholders);
|
||||
HvTOTALKEYS(hv) -= placeholders;
|
||||
}
|
||||
|
||||
/* We could check in the loop to see if we encounter any keys with key
|
||||
|
||||
56
t/op/hash-clear-placeholders.t
Normal file
56
t/op/hash-clear-placeholders.t
Normal file
@ -0,0 +1,56 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
BEGIN {
|
||||
chdir 't' if -d 't';
|
||||
require './test.pl';
|
||||
set_up_inc( '../lib' );
|
||||
skip_all_without_dynamic_extension("Devel::Peek");
|
||||
skip_all_without_dynamic_extension("Hash::Util");
|
||||
}
|
||||
|
||||
use strict;
|
||||
use Devel::Peek;
|
||||
use Hash::Util qw(lock_keys_plus);
|
||||
|
||||
my %hash = (chr 255 => 42, chr 256 => 6 * 9);
|
||||
lock_keys_plus(%hash, "baz");
|
||||
|
||||
my $tempfile = tempfile();
|
||||
|
||||
local *OLDERR;
|
||||
open(OLDERR, ">&STDERR") || die "Can't dup STDERR: $!";
|
||||
open(STDERR, ">", $tempfile) ||
|
||||
die "Could not open '$tempfile' for write: $^E";
|
||||
|
||||
my $sep = "=-=-=-=\n";
|
||||
Dump \%hash;
|
||||
print STDERR $sep;
|
||||
delete $hash{chr 255};
|
||||
Internals::hv_clear_placeholders(%hash);
|
||||
Dump \%hash;
|
||||
print STDERR $sep;
|
||||
delete $hash{chr 256};
|
||||
Internals::hv_clear_placeholders(%hash);
|
||||
Dump \%hash;
|
||||
|
||||
open(STDERR, ">&OLDERR") || die "Can't dup OLDERR: $!";
|
||||
open(my $fh, "<", $tempfile) ||
|
||||
die "Could not open '$tempfile' for read: $^E";
|
||||
local $/;
|
||||
my $got = <$fh>;
|
||||
|
||||
my ($first, $second, $third) = split $sep, $got;
|
||||
|
||||
like($first, qr/\bPERL_MAGIC_rhash\b/, 'first dump has rhash magic');
|
||||
like($second, qr/\bPERL_MAGIC_rhash\b/, 'second dump has rhash magic');
|
||||
like($third, qr/\bPERL_MAGIC_rhash\b/, 'third dump has rhash magic');
|
||||
|
||||
like($first, qr/\bHASKFLAGS\b/, 'first dump has HASHKFLAGS set');
|
||||
like($second, qr/\bHASKFLAGS\b/, 'second dump has HASHKFLAGS set');
|
||||
unlike($third, qr/\bHASKFLAGS\b/, 'third dump has HASHKFLAGS clear');
|
||||
|
||||
like($first, qr/\bMG_LEN = 1\b/, 'first dump has 1 placeholder');
|
||||
unlike($second, qr/\bMG_LEN\b/, 'second dump has 0 placeholders');
|
||||
unlike($third, qr/\bMG_LEN\b/, 'third dump has 0 placeholders');
|
||||
|
||||
done_testing();
|
||||
Loading…
x
Reference in New Issue
Block a user