Move CPAN from ext/ to cpan/

[p5sagit/p5-mst-13.2.git] / cpan / IPC-SysV / t / sem.t

################################################################################
#
#  $Revision: 15 $
#  $Author: mhx $
#  $Date: 2008/11/28 18:08:11 +0100 $
#
################################################################################
#
#  Version 2.x, Copyright (C) 2007, Marcus Holland-Moritz <mhx@cpan.org>.
#  Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.
#
################################################################################

BEGIN {
  if ($ENV{'PERL_CORE'}) {
    chdir 't' if -d 't';
    @INC = '../lib' if -d '../lib' && -d '../ext';
  }

  require Test::More; import Test::More;
  require Config; import Config;

  if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
    plan(skip_all => 'IPC::SysV was not built');
  }
}

if ($Config{'d_sem'} ne 'define') {
  plan(skip_all => '$Config{d_sem} undefined');
}
elsif ($Config{'d_msg'} ne 'define') {
  plan(skip_all => '$Config{d_msg} undefined');
}

use IPC::SysV qw(
	SETALL
	IPC_PRIVATE
	IPC_CREAT
	IPC_RMID
	IPC_NOWAIT
	IPC_STAT
	S_IRWXU
	S_IRWXG
	S_IRWXO
);
use IPC::Semaphore;

# FreeBSD's default limit seems to be 9
my $nsem = 5;
my $sem = sub {
  my $code = shift;
  if (exists $SIG{SYS}) {
    local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") };
    return $code->();
  }
  return $code->();
}->(sub { IPC::Semaphore->new(IPC_PRIVATE, $nsem, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT) });

unless (defined $sem) {
  my $info = "IPC::Semaphore->new failed: $!";
  if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
      $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
    plan(skip_all => $info);
  }
  else {
    die $info;
  }
}

plan(tests => 11);

pass('acquired a semaphore');

ok(my $st = $sem->stat,'stat it');

ok($sem->setall((0) x $nsem), 'set all');

my @sem = $sem->getall;
cmp_ok(join("", @sem), 'eq', "00000", 'get all');

$sem[2] = 1;
ok($sem->setall(@sem), 'set after change');

@sem = $sem->getall;
cmp_ok(join("", @sem), 'eq', "00100", 'get again');

my $ncnt = $sem->getncnt(0);
ok(!$sem->getncnt(0), 'procs waiting now');
ok(defined($ncnt), 'prev procs waiting');

ok($sem->op(2, -1, IPC_NOWAIT), 'op nowait');

ok(!$sem->getncnt(0), 'no procs waiting');

END {
  ok($sem->remove, 'remove semaphore') if defined $sem;
}