t/lib/ipc_sysv.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5
   6     unshift @INC, '../lib';
   7
   8     require Config; import Config;
   9
  10     unless ($Config{'d_msg'} eq 'define' &&
  11             $Config{'d_sem'} eq 'define') {
  12         print "1..0\n";
  13         exit;
  14     }
  15 }
  16
  17 # These constants are common to all tests.
  18 # Later the sem* tests will import more for themselves.
  19
  20 use IPC::SysV qw(IPC_PRIVATE IPC_NOWAIT IPC_STAT IPC_RMID
  21                  S_IRWXU S_IRWXG S_IRWXO S_IWGRP S_IROTH S_IWOTH);
  22 use strict;
  23
  24 print "1..16\n";
  25
  26 my $msg;
  27 my $sem;
  28
  29 $SIG{__DIE__} = 'cleanup'; # will cleanup $msg and $sem if needed
  30
  31 # FreeBSD is known to throw this if there's no SysV IPC in the kernel.
  32 $SIG{SYS} = sub {
  33     print STDERR <<EOM;
  34 SIGSYS caught.
  35 It may be that your kernel does not have SysV IPC configured.
  36
  37 EOM
  38     if ($^O eq 'freebsd') {
  39         print STDERR <<EOM;
  40 You must have following options in your kernel:
  41
  42 options         SYSVSHM
  43 options         SYSVSEM
  44 options         SYSVMSG
  45
  46 See config(8).
  47 EOM
  48     }
  49     exit(1);
  50 };
  51
  52 my $perm;
  53
  54 $perm = S_IRWXU | S_IRWXG | S_IRWXO | S_IWGRP | S_IROTH | S_IWOTH
  55     if $^O eq 'vmesa';
  56
  57 $perm = S_IRWXU | S_IRWXG | S_IRWXO unless defined $perm;
  58
  59 if ($Config{'d_msgget'} eq 'define' &&
  60     $Config{'d_msgctl'} eq 'define' &&
  61     $Config{'d_msgsnd'} eq 'define' &&
  62     $Config{'d_msgrcv'} eq 'define') {
  63
  64     $msg = msgget(IPC_PRIVATE, $perm);
  65     # Very first time called after machine is booted value may be 0
  66     die "msgget failed: $!\n" unless defined($msg) && $msg >= 0;
  67
  68     print "ok 1\n";
  69
  70     #Putting a message on the queue
  71     my $msgtype = 1;
  72     my $msgtext = "hello";
  73
  74     msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not ";
  75     print "ok 2\n";
  76
  77     my $data;
  78     msgctl($msg,IPC_STAT,$data) or print "not ";
  79     print "ok 3\n";
  80
  81     print "not " unless length($data);
  82     print "ok 4\n";
  83
  84     my $msgbuf;
  85     msgrcv($msg,$msgbuf,256,0,IPC_NOWAIT) or print "not ";
  86     print "ok 5\n";
  87
  88     my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
  89
  90     print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext);
  91     print "ok 6\n";
  92 } else {
  93     for (1..6) {
  94         print "ok $_\n"; # fake it
  95     }
  96 }
  97
  98 if($Config{'d_semget'} eq 'define' &&
  99    $Config{'d_semctl'} eq 'define') {
 100
 101     if ($Config{'d_semctl_semid_ds'} eq 'define' ||
 102         $Config{'d_semctl_semun'}    eq 'define') {
 103
 104         use IPC::SysV qw(IPC_CREAT GETALL SETALL);
 105
 106         $sem = semget(IPC_PRIVATE, 10, $perm | IPC_CREAT);
 107         # Very first time called after machine is booted value may be 0
 108         die "semget: $!\n" unless defined($sem) && $sem >= 0;
 109
 110         print "ok 7\n";
 111
 112         my $data;
 113         semctl($sem,0,IPC_STAT,$data) or print "not ";
 114         print "ok 8\n";
 115
 116         print "not " unless length($data);
 117         print "ok 9\n";
 118
 119         my $nsem = 10;
 120
 121         semctl($sem,0,SETALL,pack("s!*",(0) x $nsem)) or print "not ";
 122         print "ok 10\n";
 123
 124         $data = "";
 125         semctl($sem,0,GETALL,$data) or print "not ";
 126         print "ok 11\n";
 127
 128         print "not " unless length($data) == length(pack("s!*",(0) x $nsem));
 129         print "ok 12\n";
 130
 131         my @data = unpack("s!*",$data);
 132
 133         my $adata = "0" x $nsem;
 134
 135         print "not " unless @data == $nsem and join("",@data) eq $adata;
 136         print "ok 13\n";
 137
 138         my $poke = 2;
 139
 140         $data[$poke] = 1;
 141         semctl($sem,0,SETALL,pack("s!*",@data)) or print "not ";
 142         print "ok 14\n";
 143
 144         $data = "";
 145         semctl($sem,0,GETALL,$data) or print "not ";
 146         print "ok 15\n";
 147
 148         @data = unpack("s!*",$data);
 149
 150         my $bdata = "0" x $poke . "1" . "0" x ($nsem-$poke-1);
 151
 152         print "not " unless join("",@data) eq $bdata;
 153         print "ok 16\n";
 154     } else {
 155         for (7..16) {
 156             print "ok $_ # skipped, no semctl possible\n";
 157         }
 158     }
 159 } else {
 160     for (7..16) {
 161         print "ok $_\n"; # fake it
 162     }
 163 }
 164
 165 sub cleanup {
 166     msgctl($msg,IPC_RMID,0)       if defined $msg;
 167     semctl($sem,0,IPC_RMID,undef) if defined $sem;
 168 }
 169
 170 cleanup;