Thread::Queue 2.11
[perl.git] / lib / Thread / Queue / t / 02_refs.t
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();
26 plan('tests' => 46);
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
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
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');
85 $q->enqueue($sref1, $sref2, $foo, $qux);
86 is($q->pending(), 8, 'Queue count');
87 $q->enqueue($cir1, $cir1s, $cir2, $cir3);
88 is($q->pending(), 12, 'Queue count');
89
90 # Process items in thread
91 threads->create(sub {
92     is($q->pending(), 12, 'Queue count in thread');
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
135     my $myfoo = $q->dequeue();
136     is_deeply($myfoo, $foo, 'Array ref');
137
138     my $qux = $q->dequeue();
139     is_deeply($$$$qux, $foo, 'Ref of ref');
140
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
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 exit(0);
188
189 # EOF