Commit | Line | Data |
13c1b207 |
1 | use warnings; |
2 | |
0dc5f2bb |
3 | BEGIN { |
4 | # chdir 't' if -d 't'; |
5 | # push @INC ,'../lib'; |
6 | require Config; import Config; |
7 | unless ($Config{'useithreads'}) { |
8 | print "1..0 # Skip: no useithreads\n"; |
9 | exit 0; |
10 | } |
11 | } |
12 | |
13 | |
14 | sub ok { |
15 | my ($id, $ok, $name) = @_; |
16 | |
13c1b207 |
17 | $name = '' unless defined $name; |
0dc5f2bb |
18 | # You have to do it this way or VMS will get confused. |
19 | print $ok ? "ok $id - $name\n" : "not ok $id - $name\n"; |
20 | |
21 | printf "# Failed test at line %d\n", (caller)[2] unless $ok; |
22 | |
23 | return $ok; |
24 | } |
25 | |
6b85e4fe |
26 | sub skip { |
27 | my ($id, $ok, $name) = @_; |
28 | print "ok $id # skip _thrcnt - $name \n"; |
29 | } |
0dc5f2bb |
30 | |
31 | use ExtUtils::testlib; |
32 | use strict; |
938785a2 |
33 | BEGIN { print "1..17\n" }; |
0dc5f2bb |
34 | use threads; |
9c4972d9 |
35 | use threads::shared qw(:DEFAULT _thrcnt _refcnt _id); |
0dc5f2bb |
36 | ok(1,1,"loaded"); |
37 | my $foo; |
38 | share($foo); |
39 | my %foo; |
40 | share(%foo); |
41 | $foo{"foo"} = \$foo; |
13c1b207 |
42 | ok(2, !defined ${$foo{foo}}, "Check deref"); |
0dc5f2bb |
43 | $foo = "test"; |
44 | ok(3, ${$foo{foo}} eq "test", "Check deref after assign"); |
45 | threads->create(sub{${$foo{foo}} = "test2";})->join(); |
46 | ok(4, $foo eq "test2", "Check after assign in another thread"); |
9c4972d9 |
47 | skip(5, _thrcnt($foo) == 2, "Check refcount"); |
0dc5f2bb |
48 | my $bar = delete($foo{foo}); |
49 | ok(6, $$bar eq "test2", "check delete"); |
9c4972d9 |
50 | skip(7, _thrcnt($foo) == 1, "Check refcount after delete"); |
409b1fd3 |
51 | threads->create( sub { |
9c4972d9 |
52 | my $test; |
53 | share($test); |
54 | $test = "thread3"; |
55 | $foo{test} = \$test; |
56 | })->join(); |
6b85e4fe |
57 | ok(8, ${$foo{test}} eq "thread3", "Check reference created in another thread"); |
409b1fd3 |
58 | my $gg = $foo{test}; |
59 | $$gg = "test"; |
6b85e4fe |
60 | ok(9, ${$foo{test}} eq "test", "Check reference"); |
9c4972d9 |
61 | skip(10, _thrcnt($gg) == 2, "Check refcount"); |
409b1fd3 |
62 | my $gg2 = delete($foo{test}); |
9c4972d9 |
63 | skip(11, _thrcnt($gg) == 1, "Check refcount"); |
13c1b207 |
64 | ok(12, _id($$gg) == _id($$gg2), |
9c4972d9 |
65 | sprintf("Check we get the same thing (%x vs %x)", |
66 | _id($$gg),_id($$gg2))); |
409b1fd3 |
67 | ok(13, $$gg eq $$gg2, "And check the values are the same"); |
68 | ok(14, keys %foo == 0, "And make sure we realy have deleted the values"); |
938785a2 |
69 | { |
70 | my (%hash1, %hash2); |
71 | share(%hash1); |
72 | share(%hash2); |
73 | $hash1{hash} = \%hash2; |
74 | $hash2{"bar"} = "foo"; |
75 | ok(15, $hash1{hash}->{bar} eq "foo", "Check hash references work"); |
76 | threads->create(sub { $hash2{"bar2"} = "foo2"})->join(); |
77 | ok(16, $hash1{hash}->{bar2} eq "foo2", "Check hash references work"); |
78 | threads->create(sub { my (%hash3); share(%hash3); $hash2{hash} = \%hash3; $hash3{"thread"} = "yes"})->join(); |
79 | ok(17, $hash1{hash}->{hash}->{thread} eq "yes", "Check hash created in another thread"); |
80 | } |
409b1fd3 |
81 | |