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' => 39);
  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 # Queue up items
  66 my $q = Thread::Queue->new(\@ary1, \@ary2);
  67 ok($q, 'New queue');
  68 is($q->pending(), 2, 'Queue count');
  69 $q->enqueue($obj1, $obj2);
  70 is($q->pending(), 4, 'Queue count');
  71 $q->enqueue($sref1, $sref2, $qux);
  72 is($q->pending(), 7, 'Queue count');
  73
  74 # Process items in thread
  75 threads->create(sub {
  76     is($q->pending(), 7, 'Queue count in thread');
  77
  78     my $tary1 = $q->dequeue();
  79     ok($tary1, 'Thread got item');
  80     is(ref($tary1), 'ARRAY', 'Item is array ref');
  81     is_deeply($tary1, \@ary1, 'Complex array');
  82     $$tary1[1] = 123;
  83
  84     my $tary2 = $q->dequeue();
  85     ok($tary2, 'Thread got item');
  86     is(ref($tary2), 'ARRAY', 'Item is array ref');
  87     for (my $ii=0; $ii < @ary2; $ii++) {
  88         is($$tary2[$ii], $ary2[$ii], 'Shared array element check');
  89     }
  90     $$tary2[1] = 444;
  91
  92     my $tobj1 = $q->dequeue();
  93     ok($tobj1, 'Thread got item');
  94     is(ref($tobj1), 'Foo', 'Item is object');
  95     is_deeply($tobj1, $obj1, 'Object comparison');
  96     $$tobj1{'foo'} = '.|.';
  97     $$tobj1{'smiley'} = ':)';
  98
  99     my $tobj2 = $q->dequeue();
 100     ok($tobj2, 'Thread got item');
 101     is(ref($tobj2), 'Bar', 'Item is object');
 102     is($$tobj2{'bar'}, 86, 'Shared object element check');
 103     is($$tobj2{'key'}, 'foo', 'Shared object element check');
 104     $$tobj2{'tick'} = 'tock';
 105     $$tobj2{'frowny'} = ':(';
 106
 107     my $tsref1 = $q->dequeue();
 108     ok($tsref1, 'Thread got item');
 109     is(ref($tsref1), 'SCALAR', 'Item is scalar ref');
 110     is($$tsref1, 'foo', 'Scalar ref contents');
 111     $$tsref1 = 0;
 112
 113     my $tsref2 = $q->dequeue();
 114     ok($tsref2, 'Thread got item');
 115     is(ref($tsref2), 'Baz', 'Item is object');
 116     is($$tsref2, 69, 'Shared scalar ref contents');
 117     $$tsref2 = 'zzz';
 118
 119     my $qux = $q->dequeue();
 120     is_deeply($$$$qux, $foo, 'Ref of ref');
 121
 122     is($q->pending(), 0, 'Empty queue');
 123     my $nothing = $q->dequeue_nb();
 124     ok(! defined($nothing), 'Nothing on queue');
 125 })->join();
 126
 127 # Check results of thread's activities
 128 is($q->pending(), 0, 'Empty queue');
 129
 130 is($ary1[1], 'bar', 'Array unchanged');
 131 is($ary2[1], 444, 'Shared array changed');
 132
 133 is($$obj1{'foo'}, 'bar', 'Object unchanged');
 134 ok(! exists($$obj1{'smiley'}), 'Object unchanged');
 135
 136 is($$obj2{'tick'}, 'tock', 'Shared object changed');
 137 is($$obj2{'frowny'}, ':(', 'Shared object changed');
 138
 139 is($$sref1, 'foo', 'Scalar ref unchanged');
 140 is($$sref2, 'zzz', 'Shared scalar ref changed');
 141
 142 # EOF