t/IPC-Semaphore-Concurrency.t

   1 # Before `make install' is performed this script should be runnable with
   2 # `make test'. After `make install' it should work as `perl IPC-Semaphore-Concurrency.t'
   3
   4 #########################
   5
   6 # change 'tests => 1' to 'tests => last_test_to_print';
   7
   8 use Test::More;
   9 use POSIX qw(O_WRONLY O_CREAT O_NONBLOCK O_NOCTTY WNOHANG);
  10 use strict;
  11 use warnings;
  12
  13 #########################
  14
  15 # Insert your test code below, the Test::More module is use()ed here so read
  16 # its man page ( perldoc Test::More ) for help writing this test script.
  17
  18 # Skip all if the testing architecture doesn't support semaphores
  19 # bits taken from IPC::SysV tests...
  20 use Config;
  21 if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
  22     plan(skip_all => 'IPC::SysV was not built');
  23 }
  24 if ($Config{'d_sem'} ne 'define' || $Config{'d_semget'} ne 'define' ||
  25     $Config{'d_semctl'} ne 'define') {
  26   plan(skip_all => 'Lacking d_sem, d_semget or d_semctl');
  27 }
  28
  29 # My handy Acme Child Reaper(tm)
  30 $SIG{'CHLD'} = sub { while (waitpid(-1, WNOHANG) > 0) {} };
  31
  32 my $file = undef;
  33 my $base = ".IPC-Semaphore-Concurrency.test";
  34
  35 # Try different paths for writing the semaphore files
  36 foreach my $prefix ('/tmp/', '/var/tmp/', '') {
  37         my $tmpfile = $prefix.$base;
  38         if (sysopen(my $f, "$tmpfile-0.$$", O_WRONLY|O_CREAT|O_NONBLOCK|O_NOCTTY)) {
  39                 $file = $tmpfile;
  40                 # $base now becomes what we'll use for cleaning up...
  41                 $base = $prefix;
  42                 last;
  43         }
  44 }
  45
  46 if (!defined($file)) {
  47         plan skip_all => "Can't create a file for named semaphores: $!";
  48 } else {
  49         plan tests => 5;
  50 }
  51
  52 # Can't do that at compile time with a flexible plan, but we don't use prototypes anyway
  53 use_ok('IPC::Semaphore::Concurrency');
  54
  55 # Simple semaphore usage
  56 my $c = IPC::Semaphore::Concurrency->new("$file-1.$$");
  57 ok(defined($c), "Simple usage");
  58
  59 # Remove semaphore
  60 ok($c->remove(), "Remove semaphore");
  61
  62
  63 # Full semaphore usage
  64 $c = IPC::Semaphore::Concurrency->new(
  65         path    => "$file-2.$$",
  66         touch   => 1,
  67         project => 8,
  68         count   => 20,
  69         value   => 1,
  70         );
  71 ok(defined($c), "Full usage");
  72
  73 # Remove semaphore
  74 ok($c->remove(), "Remove semaphore");
  75
  76
  77 # Clean up files
  78 system('rm -rf '.$base.'.IPC-Semaphore-Concurrency.test-*');
  79