mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

Make local $h{$k} remove previously non-existing key from shared hashes

Browse Source
This commit is contained in:
Leon Timmermans 2024-05-29 19:37:16 +02:00
parent 1a2e8e708a
commit 05112e5eac
3 changed files with 40 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
dist/threads-shared/lib/threads/shared.pm vendored
View File

@ -8,7 +8,7 @@ use Config;
use Scalar::Util qw(reftype refaddr blessed);
our $VERSION = '1.69'; # Please update the pod, too.
our $VERSION = '1.70'; # Please update the pod, too.
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@ -196,7 +196,7 @@ threads::shared - Perl extension for sharing data structures between threads
=head1 VERSION
This document describes threads::shared version 1.68
This document describes threads::shared version 1.70
=head1 SYNOPSIS

28
dist/threads-shared/shared.xs vendored
View File

@ -1080,6 +1080,14 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg)
return (0);
}
static int
sharedsv_elem_mg_free(pTHX_ SV* nsv, MAGIC *mg)
{
if (mg->mg_private)
sharedsv_elem_mg_DELETE(aTHX_ nsv, mg);
return (0);
}
/* Called during cloning of PERL_MAGIC_tiedelem(p) magic in new
* thread */
@ -1092,16 +1100,26 @@ sharedsv_elem_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
return (0);
}
static int
sharedsv_elem_mg_local(pTHX_ SV* nsv, MAGIC *mg)
{
MAGIC* magic = sv_magicext(nsv, mg->mg_obj, mg->mg_type, mg->mg_virtual,
mg->mg_ptr, mg->mg_len);
magic->mg_flags = mg->mg_flags;
magic->mg_private = mg_find(nsv, PERL_MAGIC_shared_scalar) ? 0 : 1;
return (0);
}
const MGVTBL sharedsv_elem_vtbl = {
sharedsv_elem_mg_FETCH, /* get */
sharedsv_elem_mg_STORE, /* set */
0, /* len */
sharedsv_elem_mg_DELETE, /* clear */
0, /* free */
sharedsv_elem_mg_free, /* free */
0, /* copy */
sharedsv_elem_mg_dup, /* dup */
#ifdef MGf_LOCAL
0, /* local */
sharedsv_elem_mg_local, /* local */
#endif
};
@ -1191,7 +1209,11 @@ sharedsv_array_mg_copy(pTHX_ SV *sv, MAGIC* mg,
toLOWER(mg->mg_type),&sharedsv_elem_vtbl,
name, namlen);
PERL_UNUSED_ARG(sv);
nmg->mg_flags |= MGf_DUP;
nmg->mg_flags |= MGf_DUP
#ifdef MGf_LOCAL
|MGf_LOCAL
#endif
;
return (1);
}

21
dist/threads-shared/t/hv_simple.t vendored
View File

@ -27,7 +27,7 @@ sub ok {
BEGIN {
$| = 1;
print("1..16\n"); ### Number of tests that will be run ###
print("1..18\n"); ### Number of tests that will be run ###
};
use threads;
@ -55,23 +55,28 @@ $hash{"3"} = 3;
ok(7, keys %hash == 4, "Check keys");
ok(8, exists($hash{"1"}), "Exist on existing key");
ok(9, !exists($hash{"4"}), "Exists on non existing key");
{ local $hash{"4"} = 1 }
ok(10, keys %hash == 4, "Localization left 3 keys");
ok(11, !exists($hash{"4"}), "Localization didn't leave extra key");
my %seen;
foreach my $key ( keys %hash) {
$seen{$key}++;
}
ok(10, $seen{1} == 1, "Keys..");
ok(11, $seen{2} == 1, "Keys..");
ok(12, $seen{3} == 1, "Keys..");
ok(13, $seen{"foo"} == 1, "Keys..");
ok(12, $seen{1} == 1, "Keys..");
ok(13, $seen{2} == 1, "Keys..");
ok(14, $seen{3} == 1, "Keys..");
ok(15, $seen{"foo"} == 1, "Keys..");
# bugid #24407: the stringification of the numeric 1 got allocated to the
# wrong thread memory pool, which crashes on Windows.
ok(14, exists $hash{1}, "Check numeric key");
ok(16, exists $hash{1}, "Check numeric key");
threads->create(sub { %hash = () })->join();
ok(15, keys %hash == 0, "Check clear");
ok(17, keys %hash == 0, "Check clear");
ok(16, is_shared(%hash), "Check for sharing");
ok(18, is_shared(%hash), "Check for sharing");
exit(0);