6 $SIG{__DIE__} = 'cleanup';
26 use vars map { '$' . $_ } @define;
29 unless($Config{'d_semget'} eq 'define' &&
30 $Config{'d_semctl'} eq 'define') {
37 my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
42 my($file,$level) = @_;
44 return unless defined $file;
48 foreach $dir (@incpath) {
49 my $tmp = $dir . "/" . $file;
55 return if exists $done{$path};
58 if(not defined $path and $level == 0) {
59 warn "Cannot find '$file'";
64 open(F,$path) or return;
65 $level = 1 unless defined $level;
66 my $indent = " " x $level;
67 print "#$indent open $path\n";
71 if ( /^#\s*include\s*[<"]([^>"]+)[>"]/ ) {
72 print "#${indent} include $1\n";
73 process_file($1,$level+1);
74 print "#${indent} done include $1\n";
75 print "#${indent} back in $path\n";
80 if ( /^#\s*define\s+(\w+)\s+(\w+)/ ) {
81 print "#${indent} define $1 $2\n";
86 print "#$indent close $path\n";
89 process_file("sys/sem.h");
90 process_file("sys/ipc.h");
91 process_file("sys/stat.h");
93 foreach my $d (@define) {
94 while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
95 $define{$d} = exists $define{$define{$d}}
96 ? $define{$define{$d}} : undef;
98 unless(defined $define{$d}) {
99 print "# $d undefined\n";
105 ${ $d } = eval $define{$d};
114 my $sem = semget($IPC_PRIVATE, 10, $S_IRWXU | $S_IRWXG | $S_IRWXO | $IPC_CREAT);
115 # Very first time called after machine is booted value may be 0
116 die "semget: $!\n" unless defined($sem) && $sem >= 0;
121 semctl($sem,0,$IPC_STAT,$data) or print "not ";
124 print "not " unless length($data);
129 # Find the pack/unpack template capable of handling native C shorts.
131 if ($Config{shortsize} == 2) {
133 } elsif ($Config{shortsize} == 4) {
135 } elsif ($Config{shortsize} == 8) {
136 foreach my $t (qw(i q)) { # Try quad last because not supported everywhere.
137 # We could trap the unsupported quad template with eval
138 # but if we get this far we should have quad support anyway.
139 if (length(pack($t, 0)) == 8) {
146 die "$0: cannot pack native shorts\n" unless defined $template;
152 semctl($sem,0,$SETALL,pack($template,(0) x $nsem)) or print "not ";
156 semctl($sem,0,$GETALL,$data) or print "not ";
159 print "not " unless length($data) == length(pack($template,(0) x $nsem));
162 my @data = unpack($template,$data);
164 my $adata = "0" x $nsem;
166 print "not " unless @data == $nsem and join("",@data) eq $adata;
172 semctl($sem,0,$SETALL,pack($template,@data)) or print "not ";
176 semctl($sem,0,$GETALL,$data) or print "not ";
179 @data = unpack($template,$data);
181 my $bdata = "0" x $poke . "1" . "0" x ($nsem-$poke-1);
183 print "not " unless join("",@data) eq $bdata;
186 sub cleanup { semctl($sem,0,$IPC_RMID,undef) if defined $sem }