1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
BEGIN {
chdir 't' if -d 't';
@INC = qw(. ../lib);
require Config; import Config;
require 'test.pl';
}
if ($Config{'extensions'} !~ /\bIPC\/SysV\b/) {
skip_all('IPC::SysV was not built');
}
elsif ($Config{'d_sem'} ne 'define') {
skip_all('$Config{d_sem} undefined');
}
elsif ($Config{'d_msg'} ne 'define') {
skip_all('$Config{d_msg} undefined');
}
else {
plan( tests => 11 );
}
use IPC::SysV qw(
SETALL
IPC_PRIVATE
IPC_CREAT
IPC_RMID
IPC_NOWAIT
IPC_STAT
S_IRWXU
S_IRWXG
S_IRWXO
);
use IPC::Semaphore;
my $sem =
IPC::Semaphore->new(IPC_PRIVATE, 10, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT);
if (!$sem) {
if ($! eq 'No space left on device') {
# "normal" error
diag("Bail out! cannot acquire a semaphore: $!");
exit(1);
}
else {
# unexpected error
die "semget: ",$!+0," $!\n";
}
}
pass('acquired a semaphore');
ok(my $st = $sem->stat,'stat it');
ok($sem->setall( (0) x 10),'set all');
my @sem = $sem->getall;
cmp_ok(join("",@sem),'eq',"0000000000",'get all');
$sem[2] = 1;
ok($sem->setall( @sem ),'set after change');
@sem = $sem->getall;
cmp_ok(join("",@sem),'eq',"0010000000",'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 {
if ($sem) {
ok($sem->remove,'release');
}
}
|
