Commit | Line | Data |
7fb1c73b |
1 | use strict; |
2 | use warnings; |
3 | |
4 | BEGIN { |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir('t'); |
7 | unshift(@INC, '../lib'); |
8 | } |
9 | } |
10 | |
11 | use Test::More 'tests' => 32; |
12 | |
13 | use Thread::Queue; |
14 | |
15 | # Regular array |
16 | my @ary1 = qw/foo bar baz/; |
17 | push(@ary1, [ 1..3 ], { 'qux' => 99 }); |
18 | |
19 | # Shared array |
20 | my @ary2 :shared = (99, 21, 86); |
21 | |
22 | # Regular hash-based object |
23 | my $obj1 = { |
24 | 'foo' => 'bar', |
25 | 'qux' => 99, |
26 | 'biff' => [ qw/fee fi fo/ ], |
27 | 'boff' => { 'bork' => 'true' }, |
28 | }; |
29 | bless($obj1, 'Foo'); |
30 | |
31 | # Shared hash-based object |
32 | my $obj2 = &threads::shared::share({}); |
33 | $$obj2{'bar'} = 86; |
34 | $$obj2{'key'} = 'foo'; |
35 | bless($obj2, 'Bar'); |
36 | |
37 | # Scalar ref |
38 | my $sref1 = \do{ my $scalar = 'foo'; }; |
39 | |
40 | # Shared scalar ref object |
41 | my $sref2 = \do{ my $scalar = 69; }; |
42 | threads::shared::share($sref2); |
43 | bless($sref2, 'Baz'); |
44 | |
45 | # Ref of ref |
46 | my $foo = [ 5, 'bork', { 'now' => 123 } ]; |
47 | my $bar = \$foo; |
48 | my $baz = \$bar; |
49 | my $qux = \$baz; |
50 | is_deeply($$$$qux, $foo, 'Ref of ref'); |
51 | |
52 | # Queue up items |
53 | my $q = Thread::Queue->new(\@ary1, \@ary2); |
54 | ok($q, 'New queue'); |
55 | is($q->pending(), 2, 'Queue count'); |
56 | $q->enqueue($obj1, $obj2); |
57 | is($q->pending(), 4, 'Queue count'); |
58 | $q->enqueue($sref1, $sref2, $qux); |
59 | is($q->pending(), 7, 'Queue count'); |
60 | |
61 | # Process items in queue |
62 | { |
63 | is($q->pending(), 7, 'Queue count in thread'); |
64 | |
65 | my $ref = $q->peek(3); |
66 | is(ref($ref), 'Bar', 'Item is object'); |
67 | |
68 | my $tary1 = $q->dequeue(); |
69 | ok($tary1, 'Thread got item'); |
70 | is(ref($tary1), 'ARRAY', 'Item is array ref'); |
71 | is_deeply($tary1, \@ary1, 'Complex array'); |
72 | |
73 | my $tary2 = $q->dequeue(); |
74 | ok($tary2, 'Thread got item'); |
75 | is(ref($tary2), 'ARRAY', 'Item is array ref'); |
76 | for (my $ii=0; $ii < @ary2; $ii++) { |
77 | is($$tary2[$ii], $ary2[$ii], 'Shared array element check'); |
78 | } |
79 | |
80 | my $tobj1 = $q->dequeue(); |
81 | ok($tobj1, 'Thread got item'); |
82 | is(ref($tobj1), 'Foo', 'Item is object'); |
83 | is_deeply($tobj1, $obj1, 'Object comparison'); |
84 | |
85 | my $tobj2 = $q->dequeue(); |
86 | ok($tobj2, 'Thread got item'); |
87 | is(ref($tobj2), 'Bar', 'Item is object'); |
88 | is($$tobj2{'bar'}, 86, 'Shared object element check'); |
89 | is($$tobj2{'key'}, 'foo', 'Shared object element check'); |
90 | |
91 | my $tsref1 = $q->dequeue(); |
92 | ok($tsref1, 'Thread got item'); |
93 | is(ref($tsref1), 'SCALAR', 'Item is scalar ref'); |
94 | is($$tsref1, 'foo', 'Scalar ref contents'); |
95 | |
96 | my $tsref2 = $q->dequeue(); |
97 | ok($tsref2, 'Thread got item'); |
98 | is(ref($tsref2), 'Baz', 'Item is object'); |
99 | is($$tsref2, 69, 'Shared scalar ref contents'); |
100 | |
101 | my $qux = $q->dequeue(); |
102 | is_deeply($$$$qux, $foo, 'Ref of ref'); |
103 | |
104 | is($q->pending(), 0, 'Empty queue'); |
105 | my $nothing = $q->dequeue_nb(); |
106 | ok(! defined($nothing), 'Nothing on queue'); |
107 | } |
108 | |
109 | # Check results of thread's activities |
110 | is($q->pending(), 0, 'Empty queue'); |
111 | |
3d4f2f89 |
112 | exit(0); |
113 | |
7fb1c73b |
114 | # EOF |