summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2005-05-26 11:28:24 +0000
committerNicholas Clark <nick@ccl4.org>2005-05-26 11:28:24 +0000
commit94a66813331bb98469ac6bbd2df0367b54b25a8e (patch)
tree2b94cefe85605743daec880d3bf6b8cf641351c5 /ext
parent9b70c55fe958b1da7c3c2de3a97fa739b1687085 (diff)
downloadperl-94a66813331bb98469ac6bbd2df0367b54b25a8e.tar.gz
It helps to set the total keys correctly when duplicating a hash.
It helps even more to have a test for this. p4raw-id: //depot/perl@24582
Diffstat (limited to 'ext')
-rw-r--r--ext/threads/t/problems.t21
1 files changed, 19 insertions, 2 deletions
diff --git a/ext/threads/t/problems.t b/ext/threads/t/problems.t
index f4688134e5..b43a5f0b81 100644
--- a/ext/threads/t/problems.t
+++ b/ext/threads/t/problems.t
@@ -13,12 +13,13 @@ use warnings;
use strict;
use threads;
use threads::shared;
+use Hash::Util 'lock_keys';
# Note that we can't use Test::More here, as we would need to
# call is() from within the DESTROY() function at global destruction time,
# and parts of Test::* may have already been freed by then
-print "1..10\n";
+print "1..14\n";
my $test : shared = 1;
@@ -26,7 +27,7 @@ sub is($$$) {
my ($got, $want, $desc) = @_;
unless ($got eq $want) {
print "# EXPECTED: $want\n";
- print "# GOT: got\n";
+ print "# GOT: $got\n";
print "not ";
}
print "ok $test - $desc\n";
@@ -120,4 +121,20 @@ for my $decl ('my $x : unique', 'sub foo : unique') {
# print $string eq 'foobar' ? '' : 'not ', "ok $test - returning closure\n";
# $test++;
+# Nothing is checking that total keys gets cloned correctly.
+
+my %h = (1,2,3,4);
+is (keys %h, 2, "keys correct in parent");
+
+my $child = threads->new(sub { return scalar keys %h })->join;
+is ($child, 2, "keys correct in child");
+
+lock_keys (%h);
+delete $h{1};
+
+is (keys %h, 1, "keys correct in parent with restricted hash");
+
+$child = threads->new(sub { return scalar keys %h })->join;
+is ($child, 1, "keys correct in child with restricted hash");
+
1;