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 #  Cygwin needs a cygserver running to handle IPC syscalls
  30 if ($Config{'osname'} eq 'cygwin') {
  31         system('ipcs -s >/dev/null 2>&1');
  32         if ($?) {
  33                 plan(skip_all => 'command "ipcs -s" failed; are you running cygserver?');
  34         }
  35 }
  36
  37 # My handy Acme Child Reaper(tm)
  38 $SIG{'CHLD'} = sub { while (waitpid(-1, WNOHANG) > 0) {} };
  39
  40 my $file = undef;
  41 my $base = ".IPC-Semaphore-Concurrency.test";
  42
  43 # Try different paths for writing the semaphore files
  44 foreach my $prefix ('/tmp/', '/var/tmp/', '') {
  45         my $tmpfile = $prefix.$base;
  46         if (sysopen(my $f, "$tmpfile-0.$$", O_WRONLY|O_CREAT|O_NONBLOCK|O_NOCTTY)) {
  47                 $file = $tmpfile;
  48                 # $base now becomes what we'll use for cleaning up...
  49                 $base = $prefix;
  50                 last;
  51         }
  52 }
  53
  54 if (!defined($file)) {
  55         plan skip_all => "Can't create a file for named semaphores: $!";
  56 } else {
  57         plan tests => 5;
  58 }
  59
  60 # Can't do that at compile time with a flexible plan, but we don't use prototypes anyway
  61 use_ok('IPC::Semaphore::Concurrency');
  62
  63 # Simple semaphore usage
  64 my $c = IPC::Semaphore::Concurrency->new("$file-1.$$");
  65 ok(defined($c), "Simple usage");
  66
  67 # Remove semaphore
  68 ok($c->remove(), "Remove semaphore");
  69
  70
  71 # Full semaphore usage
  72 $c = IPC::Semaphore::Concurrency->new(
  73         path    => "$file-2.$$",
  74         touch   => 1,
  75         project => 8,
  76         count   => 20,
  77         value   => 1,
  78         );
  79 ok(defined($c), "Full usage");
  80
  81 # Remove semaphore
  82 ok($c->remove(), "Remove semaphore");
  83
  84
  85 # Clean up files
  86 system('rm -rf '.$base.'.IPC-Semaphore-Concurrency.test-*');
  87