t/op/ipcsem.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     $SIG{__DIE__} = 'cleanup';
   7 }
   8
   9 my @define;
  10
  11 BEGIN {
  12     @define = qw(
  13         GETALL
  14         SETALL
  15         IPC_PRIVATE
  16         IPC_CREAT
  17         IPC_RMID
  18         IPC_STAT
  19         S_IRWXU
  20         S_IRWXG
  21         S_IRWXO
  22     );
  23 }
  24
  25 use Config;
  26 use vars map { '$' . $_ } @define;
  27
  28 BEGIN {
  29     unless($Config{'d_semget'} eq 'define' &&
  30            $Config{'d_semctl'} eq 'define') {
  31         print "1..0\n";
  32         exit;
  33     }
  34
  35     use strict;
  36
  37     my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
  38     my %done = ();
  39     my %define = ();
  40
  41     sub process_file {
  42         my($file,$level) = @_;
  43
  44         return unless defined $file;
  45
  46         my $path = undef;
  47         my $dir;
  48         foreach $dir (@incpath) {
  49             my $tmp = $dir . "/" . $file;
  50             next unless -r $tmp;
  51             $path = $tmp;
  52             last;
  53         }
  54
  55         return if exists $done{$path};
  56         $done{$path} = 1;
  57
  58         if(not defined $path and $level == 0) {
  59             warn "Cannot find '$file'";
  60             return;
  61         }
  62
  63         local(*F);
  64         open(F,$path) or return;
  65         $level = 1 unless defined $level;
  66         my $indent = " " x $level;
  67         print "#$indent open $path\n";
  68         while(<F>) {
  69             s#/\*.*(\*/|$)##;
  70
  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";
  76             }
  77
  78             s/(?:\([^)]*\)\s*)//;
  79
  80             if ( /^#\s*define\s+(\w+)\s+(\w+)/ ) {
  81                 print "#${indent} define $1 $2\n";
  82                 $define{$1} = $2;
  83             }
  84        }
  85        close(F);
  86        print "#$indent close $path\n";
  87     }
  88
  89     process_file("sys/sem.h");
  90     process_file("sys/ipc.h");
  91     process_file("sys/stat.h");
  92
  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;
  97         }
  98         unless(defined $define{$d}) {
  99             print "# $d undefined\n";
 100             print "1..0\n";
 101             exit;
 102         }
 103         {
 104             no strict 'refs';
 105             ${ $d } = eval $define{$d};
 106         }
 107     }
 108 }
 109
 110 use strict;
 111
 112 print "1..10\n";
 113
 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;
 117
 118 print "ok 1\n";
 119
 120 my $data;
 121 semctl($sem,0,$IPC_STAT,$data) or print "not ";
 122 print "ok 2\n";
 123
 124 print "not " unless length($data);
 125 print "ok 3\n";
 126
 127 my $template;
 128
 129 # Find the pack/unpack template capable of handling native C shorts.
 130
 131 if      ($Config{shortsize} == 2) {
 132     $template = "s";
 133 } elsif ($Config{shortsize} == 4) {
 134     $template = "l";
 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) {
 140             $template = $t;
 141             last;
 142         }
 143     }
 144 }
 145
 146 die "$0: cannot pack native shorts\n" unless defined $template;
 147
 148 $template .= "*";
 149
 150 my $nsem = 10;
 151
 152 semctl($sem,0,$SETALL,pack($template,(0) x $nsem)) or print "not ";
 153 print "ok 4\n";
 154
 155 $data = "";
 156 semctl($sem,0,$GETALL,$data) or print "not ";
 157 print "ok 5\n";
 158
 159 print "not " unless length($data) == length(pack($template,(0) x $nsem));
 160 print "ok 6\n";
 161
 162 my @data = unpack($template,$data);
 163
 164 my $adata = "0" x $nsem;
 165
 166 print "not " unless @data == $nsem and join("",@data) eq $adata;
 167 print "ok 7\n";
 168
 169 my $poke = 2;
 170
 171 $data[$poke] = 1;
 172 semctl($sem,0,$SETALL,pack($template,@data)) or print "not ";
 173 print "ok 8\n";
 174
 175 $data = "";
 176 semctl($sem,0,$GETALL,$data) or print "not ";
 177 print "ok 9\n";
 178
 179 @data = unpack($template,$data);
 180
 181 my $bdata = "0" x $poke . "1" . "0" x ($nsem-$poke-1);
 182
 183 print "not " unless join("",@data) eq $bdata;
 184 print "ok 10\n";
 185
 186 sub cleanup { semctl($sem,0,$IPC_RMID,undef) if defined $sem }
 187
 188 cleanup;