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 "1..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 "1..0\n";
  85             exit;
  86         };
  87         ${ $d } = eval $define{$d};
  88     }
  89 }
  90
  91 use strict;
  92
  93 # This test doesn't seem to work properly yet so skip it for _65
  94 print "1..0\n";
  95 exit;
  96
  97
  98 print "1..10\n";
  99
 100 my $sem = semget($IPC_PRIVATE, 10, $S_IRWXU | $S_IRWXG | $S_IRWXO | $IPC_CREAT)
 101         || die "semget: $!\n";
 102
 103 print "ok 1\n";
 104
 105 my $data;
 106 semctl($sem,0,$IPC_STAT,$data) or print "not ";
 107 print "ok 2\n";
 108
 109 print "not " unless length($data);
 110 print "ok 3\n";
 111
 112 semctl($sem,0,$SETALL,pack("s*",(0) x 10)) or print "not ";
 113 print "ok 4\n";
 114
 115 $data = "";
 116 semctl($sem,0,$GETALL,$data) or print "not ";
 117 print "ok 5\n";
 118
 119 print "not " unless length($data);
 120 print "ok 6\n";
 121
 122 my @data = unpack("s*",$data);
 123
 124 print "not " unless join("",@data) eq "0000000000";
 125 print "ok 7\n";
 126
 127 $data[2] = 1;
 128 semctl($sem,0,$SETALL,pack("s*",@data)) or print "not ";
 129 print "ok 8\n";
 130
 131 $data = "";
 132 semctl($sem,0,$GETALL,$data) or print "not ";
 133 print "ok 9\n";
 134
 135 @data = unpack("s*",$data);
 136
 137 print "not " unless join("",@data) eq "0010000000";
 138 print "ok 10\n";
 139
 140 semctl($sem,0,$IPC_RMID,undef);
 141