[win32] merge change#887 from maintbranch
[p5sagit/p5-mst-13.2.git] / t / op / ipcsem.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 my @define;
9
10 BEGIN {
11     @define = qw(
12         GETALL
13         SETALL
14         IPC_PRIVATE
15         IPC_CREAT
16         IPC_RMID
17         IPC_STAT
18         S_IRWXU
19         S_IRWXG
20         S_IRWXO
21     );
22 }
23
24 use Config;
25 use vars map { '$' . $_ } @define;
26
27 BEGIN {
28     unless($Config{'d_semget'} eq 'define' &&
29            $Config{'d_semctl'} eq 'define') {
30         print "0..0\n";
31         exit;
32     }
33     my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
34     my %done = ();
35     my %define = ();
36
37     sub process_file {
38         my($file) = @_;
39
40         return unless defined $file;
41
42         my $path = undef;
43         my $dir;
44         foreach $dir (@incpath) {
45             my $tmp = $dir . "/" . $file;
46             next unless -r $tmp;
47             $path = $tmp;
48             last;
49         }
50
51         return if exists $done{$path};
52         $done{$path} = 1;
53
54         unless(defined $path) {
55             warn "Cannot find '$file'";
56             return;
57         }
58
59         open(F,$path) or return;
60         while(<F>) {
61             s#/\*.*(\*/|$)##;
62
63             process_file($mm,$1)
64                     if /^#\s*include\s*[<"]([^>"]+)[>"]/;
65
66             s/(?:\([^)]*\)\s*)//;
67
68             $define{$1} = $2
69                 if /^#\s*define\s+(\w+)\s+((0x)?\d+|\w+)/;
70        }
71        close(F);
72     }
73
74     process_file("sys/sem.h");
75     process_file("sys/ipc.h");
76     process_file("sys/stat.h");
77
78     foreach $d (@define) {
79         while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
80             $define{$d} = exists $define{$define{$d}}
81                     ? $define{$define{$d}} : undef;
82         }
83         unless(defined $define{$d}) {
84             print "0..0\n";
85             exit;
86         };
87         ${ $d } = eval $define{$d};
88     }
89 }
90
91 use strict;
92
93 print "1..10\n";
94
95 my $sem = semget($IPC_PRIVATE, 10, $S_IRWXU | $S_IRWXG | $S_IRWXO | $IPC_CREAT)
96         || die "semget: $!\n";
97
98 print "ok 1\n";
99
100 my $data;
101 semctl($sem,0,$IPC_STAT,$data) or print "not ";
102 print "ok 2\n";
103
104 print "not " unless length($data);
105 print "ok 3\n";
106
107 semctl($sem,0,$SETALL,pack("s*",(0) x 10)) or print "not ";
108 print "ok 4\n";
109
110 $data = "";
111 semctl($sem,0,$GETALL,$data) or print "not ";
112 print "ok 5\n";
113
114 print "not " unless length($data);
115 print "ok 6\n";
116
117 my @data = unpack("s*",$data);
118
119 print "not " unless join("",@data) eq "0000000000";
120 print "ok 7\n";
121
122 $data[2] = 1;
123 semctl($sem,0,$SETALL,pack("s*",@data)) or print "not ";
124 print "ok 8\n";
125
126 $data = "";
127 semctl($sem,0,$GETALL,$data) or print "not ";
128 print "ok 9\n";
129
130 @data = unpack("s*",$data);
131
132 print "not " unless join("",@data) eq "0010000000";
133 print "ok 10\n";
134
135 semctl($sem,0,$IPC_RMID,undef);
136