t/op/ipcmsg.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         IPC_PRIVATE
  13         IPC_RMID
  14         IPC_NOWAIT
  15         IPC_STAT
  16         S_IRWXU
  17         S_IRWXG
  18         S_IRWXO
  19     );
  20 }
  21
  22 use Config;
  23 use vars map { '$' . $_ } @define;
  24
  25 BEGIN {
  26     unless($Config{'d_msgget'} eq 'define' &&
  27            $Config{'d_msgctl'} eq 'define' &&
  28            $Config{'d_msgsnd'} eq 'define' &&
  29            $Config{'d_msgrcv'} eq 'define') {
  30         print "1..0\n";
  31         exit;
  32     }
  33
  34     use strict;
  35
  36     my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
  37     my %done = ();
  38     my %define = ();
  39
  40     sub process_file {
  41         my($file,$level) = @_;
  42
  43         return unless defined $file;
  44
  45         my $path = undef;
  46         my $dir;
  47         foreach $dir (@incpath) {
  48             my $tmp = $dir . "/" . $file;
  49             next unless -r $tmp;
  50             $path = $tmp;
  51             last;
  52         }
  53
  54         return if exists $done{$path};
  55         $done{$path} = 1;
  56
  57         unless(defined $path) {
  58             warn "Cannot find '$file'" if $level == 0;
  59             return;
  60         }
  61
  62         local *F;
  63
  64         open(F,$path) or return;
  65         $level = 0 unless defined $level;
  66         while(<F>) {
  67             s#/\*.*(\*/|$)##;
  68
  69             process_file($1,$level+1)
  70                     if /^#\s*include\s*[<"]([^>"]+)[>"]/;
  71
  72             s/(?:\([^)]*\)\s*)//;
  73
  74             $define{$1} = $2
  75                 if /^#\s*define\s+(\w+)\s+((0x)?\d+|\w+)/;
  76        }
  77        close(F);
  78     }
  79
  80     process_file("sys/sem.h");
  81     process_file("sys/ipc.h");
  82     process_file("sys/stat.h");
  83
  84     foreach my $d (@define) {
  85         while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
  86             $define{$d} = exists $define{$define{$d}}
  87                     ? $define{$define{$d}} : undef;
  88         }
  89         unless(defined $define{$d}) {
  90             print "1..0\n";
  91             exit;
  92         }
  93         {
  94             no strict 'refs';
  95             ${ $d } = eval $define{$d};
  96         }
  97     }
  98 }
  99
 100 use strict;
 101
 102 print "1..6\n";
 103
 104 my $msg = msgget($IPC_PRIVATE, $S_IRWXU | $S_IRWXG | $S_IRWXO)
 105         || die "msgget failed: $!\n";
 106
 107 print "ok 1\n";
 108
 109 #Putting a message on the queue
 110 my $msgtype = 1;
 111 my $msgtext = "hello";
 112
 113 msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not ";
 114 print "ok 2\n";
 115
 116 my $data;
 117 msgctl($msg,$IPC_STAT,$data) or print "not ";
 118 print "ok 3\n";
 119
 120 print "not " unless length($data);
 121 print "ok 4\n";
 122
 123 my $msgbuf;
 124 msgrcv($msg,$msgbuf,256,0,$IPC_NOWAIT) or print "not ";
 125 print "ok 5\n";
 126
 127 my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
 128
 129 print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext);
 130 print "ok 6\n";
 131
 132 msgctl($msg,$IPC_RMID,0);
 133