1################################################################################ 2# 3# $Revision: 12 $ 4# $Author: mhx $ 5# $Date: 2010/03/07 16:01:42 +0100 $ 6# 7################################################################################ 8# 9# Version 2.x, Copyright (C) 2007-2010, 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 17BEGIN { 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 31if ($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 37use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_STAT S_IRWXU S_IRWXG S_IRWXO); 38use strict; 39 40use IPC::Msg; 41#Creating a message queue 42 43my $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 52unless (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 63plan(tests => 9); 64 65pass('create message queue'); 66 67#Putting a message on the queue 68my $test_name = 'enqueue message'; 69 70my $msgtype = 1; 71my $msg = "hello"; 72if ($msq->snd($msgtype,$msg,IPC_NOWAIT)) { 73 pass($test_name); 74} 75else { 76 print "# snd: $!\n"; 77 fail($test_name); 78} 79 80#Check if there are messages on the queue 81my $ds = $msq->stat; 82ok($ds, 'stat'); 83 84if ($ds) { 85 is($ds->qnum, 1, 'qnum'); 86} 87else { 88 fail('qnum'); 89} 90 91#Retrieving a message from the queue 92my $rmsg; 93my $rmsgtype = 0; # Give me any type 94$rmsgtype = $msq->rcv($rmsg,256,$rmsgtype,IPC_NOWAIT); 95is($rmsgtype, $msgtype, 'rmsgtype'); 96is($rmsg, $msg, 'rmsg'); 97 98$ds = $msq->stat; 99ok($ds, 'stat'); 100 101if ($ds) { 102 is($ds->qnum, 0, 'qnum'); 103} 104else { 105 fail('qnum'); 106} 107 108END { 109 ok($msq->remove, 'remove message') if defined $msq; 110} 111