ext/IPC-SysV/t/msg.t

   1 ################################################################################
   2 #
   3 #  $Revision: 11 $
   4 #  $Author: mhx $
   5 #  $Date: 2008/11/28 18:08:11 +0100 $
   6 #
   7 ################################################################################
   8 #
   9 #  Version 2.x, Copyright (C) 2007, Marcus Holland-Moritz <mhx@cpan.org>.
  10 #  Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
  11 #
  12 #  This program is free software; you can redistribute it and/or
  13 #  modify it under the same terms as Perl itself.
  14 #
  15 ################################################################################
  16
  17 BEGIN {
  18   if ($ENV{'PERL_CORE'}) {
  19     chdir 't' if -d 't';
  20     @INC = '../lib' if -d '../lib' && -d '../ext';
  21   }
  22
  23   require Test::More; import Test::More;
  24   require Config; import Config;
  25
  26   if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
  27     plan(skip_all => 'IPC::SysV was not built');
  28   }
  29 }
  30
  31 if ($Config{'d_sem'} ne 'define') {
  32   plan(skip_all => '$Config{d_sem} undefined');
  33 } elsif ($Config{'d_msg'} ne 'define') {
  34   plan(skip_all => '$Config{d_msg} undefined');
  35 }
  36
  37 use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_STAT S_IRWXU S_IRWXG S_IRWXO);
  38 use strict;
  39
  40 use IPC::Msg;
  41 #Creating a message queue
  42
  43 my $msq = sub {
  44   my $code = shift;
  45   if (exists $SIG{SYS}) {
  46     local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") };
  47     return $code->();
  48   }
  49   return $code->();
  50 }->(sub { new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO) });
  51
  52 unless (defined $msq) {
  53   my $info = "IPC::Msg->new failed: $!";
  54   if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
  55       $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
  56     plan(skip_all => $info);
  57   }
  58   else {
  59     die $info;
  60   }
  61 }
  62
  63 plan(tests => 9);
  64
  65 pass('create message queue');
  66
  67 #Putting a message on the queue
  68 my $test_name = 'enqueue message';
  69
  70 my $msgtype = 1;
  71 my $msg = "hello";
  72 if ($msq->snd($msgtype,$msg,IPC_NOWAIT)) {
  73   pass($test_name);
  74 }
  75 else {
  76   print "# snd: $!\n";
  77   fail($test_name);
  78 }
  79
  80 #Check if there are messages on the queue
  81 my $ds = $msq->stat;
  82 ok($ds, 'stat');
  83
  84 if ($ds) {
  85   is($ds->qnum, 1, 'qnum');
  86 }
  87 else {
  88   fail('qnum');
  89 }
  90
  91 #Retrieving a message from the queue
  92 my $rmsg;
  93 my $rmsgtype = 0; # Give me any type
  94 $rmsgtype = $msq->rcv($rmsg,256,$rmsgtype,IPC_NOWAIT);
  95 is($rmsgtype, $msgtype, 'rmsgtype');
  96 is($rmsg, $msg, 'rmsg');
  97
  98 $ds = $msq->stat;
  99 ok($ds, 'stat');
 100
 101 if ($ds) {
 102   is($ds->qnum, 0, 'qnum');
 103 }
 104 else {
 105   fail('qnum');
 106 }
 107
 108 END {
 109   ok($msq->remove, 'remove message') if defined $msq;
 110 }