dist/Thread-Queue/t/02_refs.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     use Config;
   6     if (! $Config{'useithreads'}) {
   7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
   8         exit(0);
   9     }
  10 }
  11
  12 use threads;
  13 use threads::shared;
  14 use Thread::Queue;
  15
  16 if ($] == 5.008) {
  17     require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
  18 } else {
  19     require Test::More;
  20 }
  21 Test::More->import();
  22 plan('tests' => 46);
  23
  24 # Regular array
  25 my @ary1 = qw/foo bar baz/;
  26 push(@ary1, [ 1..3 ], { 'qux' => 99 });
  27
  28 # Shared array
  29 my @ary2 :shared = (99, 21, 86);
  30
  31 # Regular hash-based object
  32 my $obj1 = {
  33     'foo' => 'bar',
  34     'qux' => 99,
  35     'biff' => [ qw/fee fi fo/ ],
  36     'boff' => { 'bork' => 'true' },
  37 };
  38 bless($obj1, 'Foo');
  39
  40 # Shared hash-based object
  41 my $obj2 = &share({});
  42 $$obj2{'bar'} = 86;
  43 $$obj2{'key'} = 'foo';
  44 bless($obj2, 'Bar');
  45
  46 # Scalar ref
  47 my $sref1 = \do{ my $scalar = 'foo'; };
  48
  49 # Shared scalar ref object
  50 my $sref2 = \do{ my $scalar = 69; };
  51 share($sref2);
  52 bless($sref2, 'Baz');
  53
  54 # Ref of ref
  55 my $foo = [ 5, 'bork', { 'now' => 123 } ];
  56 my $bar = \$foo;
  57 my $baz = \$bar;
  58 my $qux = \$baz;
  59 is_deeply($$$$qux, $foo, 'Ref of ref');
  60
  61 # Circular refs
  62 my $cir1;
  63 $cir1 = \$cir1;
  64
  65 my $cir1s : shared;
  66 $cir1s = \$cir1s;
  67
  68 my $cir2;
  69 $cir2 = [ \$cir2, { 'ref' => \$cir2 } ];
  70
  71 my $cir3 :shared = &share({});
  72 $cir3->{'self'} = \$cir3;
  73 bless($cir3, 'Circular');
  74
  75 # Queue up items
  76 my $q = Thread::Queue->new(\@ary1, \@ary2);
  77 ok($q, 'New queue');
  78 is($q->pending(), 2, 'Queue count');
  79 $q->enqueue($obj1, $obj2);
  80 is($q->pending(), 4, 'Queue count');
  81 $q->enqueue($sref1, $sref2, $foo, $qux);
  82 is($q->pending(), 8, 'Queue count');
  83 $q->enqueue($cir1, $cir1s, $cir2, $cir3);
  84 is($q->pending(), 12, 'Queue count');
  85
  86 # Process items in thread
  87 threads->create(sub {
  88     is($q->pending(), 12, 'Queue count in thread');
  89
  90     my $tary1 = $q->dequeue();
  91     ok($tary1, 'Thread got item');
  92     is(ref($tary1), 'ARRAY', 'Item is array ref');
  93     is_deeply($tary1, \@ary1, 'Complex array');
  94     $$tary1[1] = 123;
  95
  96     my $tary2 = $q->dequeue();
  97     ok($tary2, 'Thread got item');
  98     is(ref($tary2), 'ARRAY', 'Item is array ref');
  99     for (my $ii=0; $ii < @ary2; $ii++) {
 100         is($$tary2[$ii], $ary2[$ii], 'Shared array element check');
 101     }
 102     $$tary2[1] = 444;
 103
 104     my $tobj1 = $q->dequeue();
 105     ok($tobj1, 'Thread got item');
 106     is(ref($tobj1), 'Foo', 'Item is object');
 107     is_deeply($tobj1, $obj1, 'Object comparison');
 108     $$tobj1{'foo'} = '.|.';
 109     $$tobj1{'smiley'} = ':)';
 110
 111     my $tobj2 = $q->dequeue();
 112     ok($tobj2, 'Thread got item');
 113     is(ref($tobj2), 'Bar', 'Item is object');
 114     is($$tobj2{'bar'}, 86, 'Shared object element check');
 115     is($$tobj2{'key'}, 'foo', 'Shared object element check');
 116     $$tobj2{'tick'} = 'tock';
 117     $$tobj2{'frowny'} = ':(';
 118
 119     my $tsref1 = $q->dequeue();
 120     ok($tsref1, 'Thread got item');
 121     is(ref($tsref1), 'SCALAR', 'Item is scalar ref');
 122     is($$tsref1, 'foo', 'Scalar ref contents');
 123     $$tsref1 = 0;
 124
 125     my $tsref2 = $q->dequeue();
 126     ok($tsref2, 'Thread got item');
 127     is(ref($tsref2), 'Baz', 'Item is object');
 128     is($$tsref2, 69, 'Shared scalar ref contents');
 129     $$tsref2 = 'zzz';
 130
 131     my $myfoo = $q->dequeue();
 132     is_deeply($myfoo, $foo, 'Array ref');
 133
 134     my $qux = $q->dequeue();
 135     is_deeply($$$$qux, $foo, 'Ref of ref');
 136
 137     my ($c1, $c1s, $c2, $c3) = $q->dequeue(4);
 138     SKIP: {
 139         skip("Needs threads::shared >= 1.19", 5)
 140             if ($threads::shared::VERSION < 1.19);
 141
 142         is(threads::shared::_id($$c1),
 143            threads::shared::_id($c1),
 144                 'Circular ref - scalar');
 145
 146         is(threads::shared::_id($$c1s),
 147            threads::shared::_id($c1s),
 148                 'Circular ref - shared scalar');
 149
 150         is(threads::shared::_id(${$c2->[0]}),
 151            threads::shared::_id($c2),
 152                 'Circular ref - array');
 153
 154         is(threads::shared::_id(${$c2->[1]->{'ref'}}),
 155            threads::shared::_id($c2),
 156                 'Circular ref - mixed');
 157
 158         is(threads::shared::_id(${$c3->{'self'}}),
 159            threads::shared::_id($c3),
 160                 'Circular ref - hash');
 161     }
 162
 163     is($q->pending(), 0, 'Empty queue');
 164     my $nothing = $q->dequeue_nb();
 165     ok(! defined($nothing), 'Nothing on queue');
 166 })->join();
 167
 168 # Check results of thread's activities
 169 is($q->pending(), 0, 'Empty queue');
 170
 171 is($ary1[1], 'bar', 'Array unchanged');
 172 is($ary2[1], 444, 'Shared array changed');
 173
 174 is($$obj1{'foo'}, 'bar', 'Object unchanged');
 175 ok(! exists($$obj1{'smiley'}), 'Object unchanged');
 176
 177 is($$obj2{'tick'}, 'tock', 'Shared object changed');
 178 is($$obj2{'frowny'}, ':(', 'Shared object changed');
 179
 180 is($$sref1, 'foo', 'Scalar ref unchanged');
 181 is($$sref2, 'zzz', 'Shared scalar ref changed');
 182
 183 exit(0);
 184
 185 # EOF