cpan/IPC-SysV/t/sem.t

   1 ################################################################################
   2 #
   3 #  $Revision: 15 $
   4 #  $Author: mhx $
   5 #  $Date: 2008/11/28 18:08:11 +0100 $
   6 #
   7 ################################################################################
   8 #
   9 #  Version 2.x, Copyright (C) 2007, Marcus Holland-Moritz <mhx@cpan.org>.
  10 #  Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
  11 #
  12 #  This program is free software; you can redistribute it and/or
  13 #  modify it under the same terms as Perl itself.
  14 #
  15 ################################################################################
  16
  17 BEGIN {
  18   if ($ENV{'PERL_CORE'}) {
  19     chdir 't' if -d 't';
  20     @INC = '../lib' if -d '../lib' && -d '../ext';
  21   }
  22
  23   require Test::More; import Test::More;
  24   require Config; import Config;
  25
  26   if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
  27     plan(skip_all => 'IPC::SysV was not built');
  28   }
  29 }
  30
  31 if ($Config{'d_sem'} ne 'define') {
  32   plan(skip_all => '$Config{d_sem} undefined');
  33 }
  34 elsif ($Config{'d_msg'} ne 'define') {
  35   plan(skip_all => '$Config{d_msg} undefined');
  36 }
  37
  38 use IPC::SysV qw(
  39         SETALL
  40         IPC_PRIVATE
  41         IPC_CREAT
  42         IPC_RMID
  43         IPC_NOWAIT
  44         IPC_STAT
  45         S_IRWXU
  46         S_IRWXG
  47         S_IRWXO
  48 );
  49 use IPC::Semaphore;
  50
  51 # FreeBSD's default limit seems to be 9
  52 my $nsem = 5;
  53 my $sem = sub {
  54   my $code = shift;
  55   if (exists $SIG{SYS}) {
  56     local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") };
  57     return $code->();
  58   }
  59   return $code->();
  60 }->(sub { IPC::Semaphore->new(IPC_PRIVATE, $nsem, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT) });
  61
  62 unless (defined $sem) {
  63   my $info = "IPC::Semaphore->new failed: $!";
  64   if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
  65       $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
  66     plan(skip_all => $info);
  67   }
  68   else {
  69     die $info;
  70   }
  71 }
  72
  73 plan(tests => 11);
  74
  75 pass('acquired a semaphore');
  76
  77 ok(my $st = $sem->stat,'stat it');
  78
  79 ok($sem->setall((0) x $nsem), 'set all');
  80
  81 my @sem = $sem->getall;
  82 cmp_ok(join("", @sem), 'eq', "00000", 'get all');
  83
  84 $sem[2] = 1;
  85 ok($sem->setall(@sem), 'set after change');
  86
  87 @sem = $sem->getall;
  88 cmp_ok(join("", @sem), 'eq', "00100", 'get again');
  89
  90 my $ncnt = $sem->getncnt(0);
  91 ok(!$sem->getncnt(0), 'procs waiting now');
  92 ok(defined($ncnt), 'prev procs waiting');
  93
  94 ok($sem->op(2, -1, IPC_NOWAIT), 'op nowait');
  95
  96 ok(!$sem->getncnt(0), 'no procs waiting');
  97
  98 END {
  99   ok($sem->remove, 'remove semaphore') if defined $sem;
 100 }