dist/Thread-Queue/t/07_lock.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 Thread::Queue;
  14 use Thread::Semaphore;
  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' => 3);
  23
  24 # The following tests locking a queue
  25
  26 my $q = Thread::Queue->new(1..10);
  27 ok($q, 'New queue');
  28
  29 my $sm = Thread::Semaphore->new(0);
  30 my $st = Thread::Semaphore->new(0);
  31
  32 threads->create(sub {
  33     {
  34         lock($q);
  35         $sm->up();
  36         $st->down();
  37         threads::yield();
  38         select(undef, undef, undef, 0.1);
  39         my @x = $q->extract(5,2);
  40         is_deeply(\@x, [6,7], 'Thread dequeues under lock');
  41     }
  42 })->detach();
  43
  44 $sm->down();
  45 $st->up();
  46 my @x = $q->dequeue_nb(100);
  47 is_deeply(\@x, [1..5,8..10], 'Main dequeues');
  48 threads::yield();
  49
  50 exit(0);
  51
  52 # EOF