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