ext/Thread-Semaphore/t/01_basic.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::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' => 10);
  27
  28 ### Basic usage with multiple threads ###
  29
  30 my $sm = Thread::Semaphore->new();
  31 my $st = Thread::Semaphore->new(0);
  32 ok($sm, 'New Semaphore');
  33 ok($st, 'New Semaphore');
  34
  35 my $token :shared = 0;
  36
  37 threads->create(sub {
  38     $st->down();
  39     is($token++, 1, 'Thread 1 got semaphore');
  40     $st->up();
  41     $sm->up();
  42
  43     $st->down(4);
  44     is($token, 5, 'Thread 1 done');
  45     $sm->up();
  46 })->detach();
  47
  48 threads->create(sub {
  49     $st->down(2);
  50     is($token++, 3, 'Thread 2 got semaphore');
  51     $st->up();
  52     $sm->up();
  53
  54     $st->down(4);
  55     is($token, 5, 'Thread 2 done');
  56     $sm->up();
  57 })->detach();
  58
  59 $sm->down();
  60 is($token++, 0, 'Main has semaphore');
  61 $st->up();
  62
  63 $sm->down();
  64 is($token++, 2, 'Main got semaphore');
  65 $st->up(2);
  66
  67 $sm->down();
  68 is($token++, 4, 'Main re-got semaphore');
  69 $st->up(9);
  70
  71 $sm->down(2);
  72 $st->down();
  73 ok(1, 'Main done');
  74 threads::yield();
  75
  76 exit(0);
  77
  78 # EOF