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