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