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