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