xref: /openbsd/gnu/usr.bin/perl/cpan/IPC-SysV/t/sem.t (revision cecf84d4) 
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
11BEGIN {
12  if ($ENV{'PERL_CORE'}) {
13    chdir 't' if -d 't';
14    @INC = '../lib' if -d '../lib' && -d '../ext';
15  }
16
17  require Test::More; import Test::More;
18  require Config; import Config;
19
20  if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
21    plan(skip_all => 'IPC::SysV was not built');
22  }
23}
24
25if ($Config{'d_sem'} ne 'define') {
26  plan(skip_all => '$Config{d_sem} undefined');
27}
28elsif ($Config{'d_msg'} ne 'define') {
29  plan(skip_all => '$Config{d_msg} undefined');
30}
31
32use IPC::SysV qw(
33	SETALL
34	IPC_PRIVATE
35	IPC_CREAT
36	IPC_RMID
37	IPC_NOWAIT
38	IPC_STAT
39	S_IRWXU
40	S_IRWXG
41	S_IRWXO
42);
43use IPC::Semaphore;
44
45# FreeBSD's default limit seems to be 9
46my $nsem = 5;
47my $sem = sub {
48  my $code = shift;
49  if (exists $SIG{SYS}) {
50    local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") };
51    return $code->();
52  }
53  return $code->();
54}->(sub { IPC::Semaphore->new(IPC_PRIVATE, $nsem, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT) });
55
56unless (defined $sem) {
57  my $info = "IPC::Semaphore->new failed: $!";
58  if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
59      $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
60    plan(skip_all => $info);
61  }
62  else {
63    die $info;
64  }
65}
66
67plan(tests => 11);
68
69pass('acquired a semaphore');
70
71ok(my $st = $sem->stat,'stat it');
72
73ok($sem->setall((0) x $nsem), 'set all');
74
75my @sem = $sem->getall;
76cmp_ok(join("", @sem), 'eq', "00000", 'get all');
77
78$sem[2] = 1;
79ok($sem->setall(@sem), 'set after change');
80
81@sem = $sem->getall;
82cmp_ok(join("", @sem), 'eq', "00100", 'get again');
83
84my $ncnt = $sem->getncnt(0);
85ok(!$sem->getncnt(0), 'procs waiting now');
86ok(defined($ncnt), 'prev procs waiting');
87
88ok($sem->op(2, -1, IPC_NOWAIT), 'op nowait');
89
90ok(!$sem->getncnt(0), 'no procs waiting');
91
92END {
93  ok($sem->remove, 'remove semaphore') if defined $sem;
94}
95