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