4 require Config; import Config;
5 unless ($Config{'useithreads'}) {
6 print "1..0 # Skip: no useithreads\n";
13 my ($id, $ok, $name) = @_;
15 # You have to do it this way or VMS will get confused.
16 print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
18 printf "# Failed test at line %d\n", (caller)[2] unless $ok;
25 use ExtUtils::testlib;
27 BEGIN { print "1..17\n" };
36 ok(2, ${$foo{foo}} == undef, "Check deref");
38 ok(3, ${$foo{foo}} eq "test", "Check deref after assign");
39 threads->create(sub{${$foo{foo}} = "test2";})->join();
40 ok(4, $foo eq "test2", "Check after assign in another thread");
41 ok(5, threads::shared::_thrcnt($foo) == 2, "Check refcount");
42 my $bar = delete($foo{foo});
43 ok(6, $$bar eq "test2", "check delete");
44 ok(7, threads::shared::_thrcnt($foo) == 1, "Check refcount after delete");
45 threads->create( sub {
51 ok(8, ${$foo{test}} eq "thread3", "Check refernece created in another thread");
54 ok(9, ${$foo{test}} eq "test", "Check refernece");
55 ok(10, threads::shared::_thrcnt($gg) == 2, "Check refcount");
56 my $gg2 = delete($foo{test});
57 ok(11, threads::shared::_thrcnt($gg) == 1, "Check refcount");
58 ok(12, $gg == $gg2, "Check we get the same reference ($gg == $gg2)");
59 ok(13, $$gg eq $$gg2, "And check the values are the same");
60 ok(14, keys %foo == 0, "And make sure we realy have deleted the values");
65 $hash1{hash} = \%hash2;
66 $hash2{"bar"} = "foo";
67 ok(15, $hash1{hash}->{bar} eq "foo", "Check hash references work");
68 threads->create(sub { $hash2{"bar2"} = "foo2"})->join();
69 ok(16, $hash1{hash}->{bar2} eq "foo2", "Check hash references work");
70 threads->create(sub { my (%hash3); share(%hash3); $hash2{hash} = \%hash3; $hash3{"thread"} = "yes"})->join();
71 ok(17, $hash1{hash}->{hash}->{thread} eq "yes", "Check hash created in another thread");