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