Commit | Line | Data |
---|---|---|
13c1b207 DM |
1 | use warnings; |
2 | ||
0dc5f2bb AB |
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 AB |
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 NIS |
26 | sub skip { |
27 | my ($id, $ok, $name) = @_; | |
28 | print "ok $id # skip _thrcnt - $name \n"; | |
29 | } | |
0dc5f2bb AB |
30 | |
31 | use ExtUtils::testlib; | |
32 | use strict; | |
5c360ac5 | 33 | BEGIN { print "1..17\n" }; |
0dc5f2bb | 34 | use threads; |
0a9af0ff | 35 | use threads::shared; |
0dc5f2bb AB |
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 AB |
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"); | |
0dc5f2bb | 47 | my $bar = delete($foo{foo}); |
48f91669 | 48 | ok(5, $$bar eq "test2", "check delete"); |
409b1fd3 | 49 | threads->create( sub { |
9c4972d9 NIS |
50 | my $test; |
51 | share($test); | |
52 | $test = "thread3"; | |
53 | $foo{test} = \$test; | |
54 | })->join(); | |
48f91669 | 55 | ok(6, ${$foo{test}} eq "thread3", "Check reference created in another thread"); |
409b1fd3 AB |
56 | my $gg = $foo{test}; |
57 | $$gg = "test"; | |
48f91669 | 58 | ok(7, ${$foo{test}} eq "test", "Check reference"); |
409b1fd3 | 59 | my $gg2 = delete($foo{test}); |
0a9af0ff | 60 | ok(8, threads::shared::_id($$gg) == threads::shared::_id($$gg2), |
9c4972d9 | 61 | sprintf("Check we get the same thing (%x vs %x)", |
0a9af0ff | 62 | threads::shared::_id($$gg),threads::shared::_id($$gg2))); |
48f91669 AB |
63 | ok(9, $$gg eq $$gg2, "And check the values are the same"); |
64 | ok(10, keys %foo == 0, "And make sure we realy have deleted the values"); | |
938785a2 AB |
65 | { |
66 | my (%hash1, %hash2); | |
67 | share(%hash1); | |
68 | share(%hash2); | |
69 | $hash1{hash} = \%hash2; | |
70 | $hash2{"bar"} = "foo"; | |
48f91669 | 71 | ok(11, $hash1{hash}->{bar} eq "foo", "Check hash references work"); |
938785a2 | 72 | threads->create(sub { $hash2{"bar2"} = "foo2"})->join(); |
48f91669 | 73 | ok(12, $hash1{hash}->{bar2} eq "foo2", "Check hash references work"); |
938785a2 | 74 | threads->create(sub { my (%hash3); share(%hash3); $hash2{hash} = \%hash3; $hash3{"thread"} = "yes"})->join(); |
48f91669 | 75 | ok(13, $hash1{hash}->{hash}->{thread} eq "yes", "Check hash created in another thread"); |
938785a2 | 76 | } |
409b1fd3 | 77 | |
5a47f09b AB |
78 | { |
79 | my $h = {a=>14}; | |
80 | my $r = \$h->{a}; | |
81 | share($r); | |
82 | lock($r); | |
83 | lock($h->{a}); | |
84 | ok(14, 1, "lock on helems now work, this was bug 10045"); | |
85 | ||
86 | } | |
5c360ac5 AB |
87 | { |
88 | my $object : shared = &share({}); | |
1cc95880 | 89 | threads->new(sub { |
1cc95880 | 90 | bless $object, 'test1'; |
f123900d | 91 | })->join; |
5c360ac5 AB |
92 | ok(15, ref($object) eq 'test1', "blessing does work"); |
93 | my %test = (object => $object); | |
94 | ok(16, ref($test{object}) eq 'test1', "and some more work"); | |
95 | bless $object, 'test2'; | |
96 | ok(17, ref($test{object}) eq 'test2', "reblessing works!"); | |
97 | } | |
5a47f09b | 98 |