Commit | Line | Data |
54c7876f |
1 | use strict; |
2 | use warnings; |
3 | |
4 | BEGIN { |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir('t'); |
7 | unshift(@INC, '../lib'); |
8 | } |
9 | use Config; |
10 | if (! $Config{'useithreads'}) { |
11 | print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); |
12 | exit(0); |
13 | } |
14 | } |
15 | |
16 | use threads; |
17 | use threads::shared; |
18 | use Thread::Queue; |
19 | |
20 | if ($] == 5.008) { |
21 | require 't/test.pl'; # Test::More work-alike for Perl 5.8.0 |
22 | } else { |
23 | require Test::More; |
24 | } |
25 | Test::More->import(); |
09782346 |
26 | plan('tests' => 46); |
54c7876f |
27 | |
28 | # Regular array |
29 | my @ary1 = qw/foo bar baz/; |
30 | push(@ary1, [ 1..3 ], { 'qux' => 99 }); |
31 | |
32 | # Shared array |
33 | my @ary2 :shared = (99, 21, 86); |
34 | |
35 | # Regular hash-based object |
36 | my $obj1 = { |
37 | 'foo' => 'bar', |
38 | 'qux' => 99, |
39 | 'biff' => [ qw/fee fi fo/ ], |
40 | 'boff' => { 'bork' => 'true' }, |
41 | }; |
42 | bless($obj1, 'Foo'); |
43 | |
44 | # Shared hash-based object |
45 | my $obj2 = &share({}); |
46 | $$obj2{'bar'} = 86; |
47 | $$obj2{'key'} = 'foo'; |
48 | bless($obj2, 'Bar'); |
49 | |
50 | # Scalar ref |
51 | my $sref1 = \do{ my $scalar = 'foo'; }; |
52 | |
53 | # Shared scalar ref object |
54 | my $sref2 = \do{ my $scalar = 69; }; |
55 | share($sref2); |
56 | bless($sref2, 'Baz'); |
57 | |
58 | # Ref of ref |
59 | my $foo = [ 5, 'bork', { 'now' => 123 } ]; |
60 | my $bar = \$foo; |
61 | my $baz = \$bar; |
62 | my $qux = \$baz; |
63 | is_deeply($$$$qux, $foo, 'Ref of ref'); |
64 | |
ac9d3a9d |
65 | # Circular refs |
66 | my $cir1; |
67 | $cir1 = \$cir1; |
68 | |
69 | my $cir1s : shared; |
70 | $cir1s = \$cir1s; |
71 | |
72 | my $cir2; |
73 | $cir2 = [ \$cir2, { 'ref' => \$cir2 } ]; |
74 | |
75 | my $cir3 :shared = &share({}); |
76 | $cir3->{'self'} = \$cir3; |
77 | bless($cir3, 'Circular'); |
78 | |
54c7876f |
79 | # Queue up items |
80 | my $q = Thread::Queue->new(\@ary1, \@ary2); |
81 | ok($q, 'New queue'); |
82 | is($q->pending(), 2, 'Queue count'); |
83 | $q->enqueue($obj1, $obj2); |
84 | is($q->pending(), 4, 'Queue count'); |
09782346 |
85 | $q->enqueue($sref1, $sref2, $foo, $qux); |
86 | is($q->pending(), 8, 'Queue count'); |
ac9d3a9d |
87 | $q->enqueue($cir1, $cir1s, $cir2, $cir3); |
09782346 |
88 | is($q->pending(), 12, 'Queue count'); |
54c7876f |
89 | |
90 | # Process items in thread |
91 | threads->create(sub { |
09782346 |
92 | is($q->pending(), 12, 'Queue count in thread'); |
54c7876f |
93 | |
94 | my $tary1 = $q->dequeue(); |
95 | ok($tary1, 'Thread got item'); |
96 | is(ref($tary1), 'ARRAY', 'Item is array ref'); |
97 | is_deeply($tary1, \@ary1, 'Complex array'); |
98 | $$tary1[1] = 123; |
99 | |
100 | my $tary2 = $q->dequeue(); |
101 | ok($tary2, 'Thread got item'); |
102 | is(ref($tary2), 'ARRAY', 'Item is array ref'); |
103 | for (my $ii=0; $ii < @ary2; $ii++) { |
104 | is($$tary2[$ii], $ary2[$ii], 'Shared array element check'); |
105 | } |
106 | $$tary2[1] = 444; |
107 | |
108 | my $tobj1 = $q->dequeue(); |
109 | ok($tobj1, 'Thread got item'); |
110 | is(ref($tobj1), 'Foo', 'Item is object'); |
111 | is_deeply($tobj1, $obj1, 'Object comparison'); |
112 | $$tobj1{'foo'} = '.|.'; |
113 | $$tobj1{'smiley'} = ':)'; |
114 | |
115 | my $tobj2 = $q->dequeue(); |
116 | ok($tobj2, 'Thread got item'); |
117 | is(ref($tobj2), 'Bar', 'Item is object'); |
118 | is($$tobj2{'bar'}, 86, 'Shared object element check'); |
119 | is($$tobj2{'key'}, 'foo', 'Shared object element check'); |
120 | $$tobj2{'tick'} = 'tock'; |
121 | $$tobj2{'frowny'} = ':('; |
122 | |
123 | my $tsref1 = $q->dequeue(); |
124 | ok($tsref1, 'Thread got item'); |
125 | is(ref($tsref1), 'SCALAR', 'Item is scalar ref'); |
126 | is($$tsref1, 'foo', 'Scalar ref contents'); |
127 | $$tsref1 = 0; |
128 | |
129 | my $tsref2 = $q->dequeue(); |
130 | ok($tsref2, 'Thread got item'); |
131 | is(ref($tsref2), 'Baz', 'Item is object'); |
132 | is($$tsref2, 69, 'Shared scalar ref contents'); |
133 | $$tsref2 = 'zzz'; |
134 | |
09782346 |
135 | my $myfoo = $q->dequeue(); |
136 | is_deeply($myfoo, $foo, 'Array ref'); |
137 | |
54c7876f |
138 | my $qux = $q->dequeue(); |
139 | is_deeply($$$$qux, $foo, 'Ref of ref'); |
140 | |
ac9d3a9d |
141 | my ($c1, $c1s, $c2, $c3) = $q->dequeue(4); |
142 | SKIP: { |
143 | skip("Needs threads::shared >= 1.19", 5) |
144 | if ($threads::shared::VERSION < 1.19); |
145 | |
146 | is(threads::shared::_id($$c1), |
147 | threads::shared::_id($c1), |
148 | 'Circular ref - scalar'); |
149 | |
150 | is(threads::shared::_id($$c1s), |
151 | threads::shared::_id($c1s), |
152 | 'Circular ref - shared scalar'); |
153 | |
154 | is(threads::shared::_id(${$c2->[0]}), |
155 | threads::shared::_id($c2), |
156 | 'Circular ref - array'); |
157 | |
158 | is(threads::shared::_id(${$c2->[1]->{'ref'}}), |
159 | threads::shared::_id($c2), |
160 | 'Circular ref - mixed'); |
161 | |
162 | is(threads::shared::_id(${$c3->{'self'}}), |
163 | threads::shared::_id($c3), |
164 | 'Circular ref - hash'); |
165 | } |
166 | |
54c7876f |
167 | is($q->pending(), 0, 'Empty queue'); |
168 | my $nothing = $q->dequeue_nb(); |
169 | ok(! defined($nothing), 'Nothing on queue'); |
170 | })->join(); |
171 | |
172 | # Check results of thread's activities |
173 | is($q->pending(), 0, 'Empty queue'); |
174 | |
175 | is($ary1[1], 'bar', 'Array unchanged'); |
176 | is($ary2[1], 444, 'Shared array changed'); |
177 | |
178 | is($$obj1{'foo'}, 'bar', 'Object unchanged'); |
179 | ok(! exists($$obj1{'smiley'}), 'Object unchanged'); |
180 | |
181 | is($$obj2{'tick'}, 'tock', 'Shared object changed'); |
182 | is($$obj2{'frowny'}, ':(', 'Shared object changed'); |
183 | |
184 | is($$sref1, 'foo', 'Scalar ref unchanged'); |
185 | is($$sref2, 'zzz', 'Shared scalar ref changed'); |
186 | |
187 | # EOF |