xref: /openbsd-src/gnu/usr.bin/perl/cpan/IPC-SysV/t/msg.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
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
11BEGIN {
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
25if ($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
31use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_STAT S_IRWXU S_IRWXG S_IRWXO);
32use strict;
33
34use IPC::Msg;
35#Creating a message queue
36
37my $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
46unless (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
57plan(tests => 9);
58
59pass('create message queue');
60
61#Putting a message on the queue
62my $test_name = 'enqueue message';
63
64my $msgtype = 1;
65my $msg = "hello";
66if ($msq->snd($msgtype,$msg,IPC_NOWAIT)) {
67  pass($test_name);
68}
69else {
70  print "# snd: $!\n";
71  fail($test_name);
72}
73
74#Check if there are messages on the queue
75my $ds = $msq->stat;
76ok($ds, 'stat');
77
78if ($ds) {
79  is($ds->qnum, 1, 'qnum');
80}
81else {
82  fail('qnum');
83}
84
85#Retrieving a message from the queue
86my $rmsg;
87my $rmsgtype = 0; # Give me any type
88$rmsgtype = $msq->rcv($rmsg,256,$rmsgtype,IPC_NOWAIT);
89is($rmsgtype, $msgtype, 'rmsgtype');
90is($rmsg, $msg, 'rmsg');
91
92$ds = $msq->stat;
93ok($ds, 'stat');
94
95if ($ds) {
96  is($ds->qnum, 0, 'qnum');
97}
98else {
99  fail('qnum');
100}
101
102END {
103  ok($msq->remove, 'remove message') if defined $msq;
104}
105