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