Commit | Line | Data |
7473853a |
1 | use strict; |
13c1b207 |
2 | use warnings; |
3 | |
0dc5f2bb |
4 | BEGIN { |
7473853a |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir 't'; |
7 | unshift @INC, '../lib'; |
8 | } |
9 | use Config; |
10 | if (! $Config{'useithreads'}) { |
6c791b15 |
11 | print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); |
7473853a |
12 | exit(0); |
0dc5f2bb |
13 | } |
14 | } |
15 | |
7473853a |
16 | use ExtUtils::testlib; |
0dc5f2bb |
17 | |
18 | sub ok { |
19 | my ($id, $ok, $name) = @_; |
20 | |
21 | # You have to do it this way or VMS will get confused. |
7473853a |
22 | if ($ok) { |
23 | print("ok $id - $name\n"); |
24 | } else { |
25 | print("not ok $id - $name\n"); |
26 | printf("# Failed test at line %d\n", (caller)[2]); |
27 | } |
0dc5f2bb |
28 | |
7473853a |
29 | return ($ok); |
0dc5f2bb |
30 | } |
31 | |
7473853a |
32 | BEGIN { |
33 | $| = 1; |
34 | print("1..20\n"); ### Number of tests that will be run ### |
35 | }; |
0dc5f2bb |
36 | |
0dc5f2bb |
37 | use threads; |
0a9af0ff |
38 | use threads::shared; |
7473853a |
39 | ok(1, 1, 'Loaded'); |
40 | |
41 | ### Start of Testing ### |
42 | |
0dc5f2bb |
43 | my $foo; |
44 | share($foo); |
45 | my %foo; |
46 | share(%foo); |
47 | $foo{"foo"} = \$foo; |
13c1b207 |
48 | ok(2, !defined ${$foo{foo}}, "Check deref"); |
0dc5f2bb |
49 | $foo = "test"; |
50 | ok(3, ${$foo{foo}} eq "test", "Check deref after assign"); |
51 | threads->create(sub{${$foo{foo}} = "test2";})->join(); |
52 | ok(4, $foo eq "test2", "Check after assign in another thread"); |
0dc5f2bb |
53 | my $bar = delete($foo{foo}); |
48f91669 |
54 | ok(5, $$bar eq "test2", "check delete"); |
409b1fd3 |
55 | threads->create( sub { |
9c4972d9 |
56 | my $test; |
57 | share($test); |
58 | $test = "thread3"; |
59 | $foo{test} = \$test; |
60 | })->join(); |
48f91669 |
61 | ok(6, ${$foo{test}} eq "thread3", "Check reference created in another thread"); |
409b1fd3 |
62 | my $gg = $foo{test}; |
63 | $$gg = "test"; |
48f91669 |
64 | ok(7, ${$foo{test}} eq "test", "Check reference"); |
409b1fd3 |
65 | my $gg2 = delete($foo{test}); |
0a9af0ff |
66 | ok(8, threads::shared::_id($$gg) == threads::shared::_id($$gg2), |
9c4972d9 |
67 | sprintf("Check we get the same thing (%x vs %x)", |
0a9af0ff |
68 | threads::shared::_id($$gg),threads::shared::_id($$gg2))); |
48f91669 |
69 | ok(9, $$gg eq $$gg2, "And check the values are the same"); |
70 | ok(10, keys %foo == 0, "And make sure we realy have deleted the values"); |
938785a2 |
71 | { |
72 | my (%hash1, %hash2); |
73 | share(%hash1); |
74 | share(%hash2); |
75 | $hash1{hash} = \%hash2; |
76 | $hash2{"bar"} = "foo"; |
48f91669 |
77 | ok(11, $hash1{hash}->{bar} eq "foo", "Check hash references work"); |
938785a2 |
78 | threads->create(sub { $hash2{"bar2"} = "foo2"})->join(); |
48f91669 |
79 | ok(12, $hash1{hash}->{bar2} eq "foo2", "Check hash references work"); |
938785a2 |
80 | threads->create(sub { my (%hash3); share(%hash3); $hash2{hash} = \%hash3; $hash3{"thread"} = "yes"})->join(); |
48f91669 |
81 | ok(13, $hash1{hash}->{hash}->{thread} eq "yes", "Check hash created in another thread"); |
938785a2 |
82 | } |
409b1fd3 |
83 | |
5a47f09b |
84 | { |
7473853a |
85 | my $h = {a=>14}; |
86 | my $r = \$h->{a}; |
87 | share($r); |
88 | if ($] > 5.008) { |
89 | eval { lock($r); }; |
90 | ok(14, !$@, "lock on helems ref: $@"); |
91 | eval { lock($h->{a}); }; |
92 | ok(15, !$@, "lock on helems: $@"); |
93 | } else { |
94 | ok(14, 1, "skipped. < 5.8"); |
95 | ok(15, 1, "skipped. < 5.8"); |
96 | } |
5a47f09b |
97 | } |
5c360ac5 |
98 | { |
99 | my $object : shared = &share({}); |
878090d5 |
100 | threads->create(sub { |
7473853a |
101 | bless $object, 'test1'; |
102 | })->join; |
103 | ok(16, ref($object) eq 'test1', "blessing does work"); |
5c360ac5 |
104 | my %test = (object => $object); |
7473853a |
105 | ok(17, ref($test{object}) eq 'test1', "and some more work"); |
5c360ac5 |
106 | bless $object, 'test2'; |
7473853a |
107 | ok(18, ref($test{object}) eq 'test2', "reblessing works!"); |
5c360ac5 |
108 | } |
5a47f09b |
109 | |
7473853a |
110 | ok(19, is_shared($foo), "Check for sharing"); |
111 | ok(20, is_shared(%foo), "Check for sharing"); |
112 | |
6c791b15 |
113 | exit(0); |
114 | |
7473853a |
115 | # EOF |