xref: /openbsd-src/gnu/usr.bin/perl/cpan/IPC-SysV/t/msg.t (revision eac174f2741a08d8deb8aae59a7f778ef9b5d770) 
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
11use strict;
12use warnings;
13
14our %Config;
15BEGIN {
16  if ($ENV{'PERL_CORE'}) {
17    chdir 't' if -d 't';
18    @INC = '../lib' if -d '../lib' && -d '../ext';
19  }
20
21  require Test::More; Test::More->import;
22  require Config; Config->import;
23
24  if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
25    plan(skip_all => 'IPC::SysV was not built');
26  }
27}
28
29if ($Config{'d_sem'} ne 'define') {
30  plan(skip_all => '$Config{d_sem} undefined');
31} elsif ($Config{'d_msg'} ne 'define') {
32  plan(skip_all => '$Config{d_msg} undefined');
33}
34
35use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_STAT S_IRWXU S_IRWXG S_IRWXO);
36
37use IPC::Msg;
38#Creating a message queue
39
40my $msq = sub {
41  my $code = shift;
42  if (exists $SIG{SYS}) {
43    local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") };
44    return $code->();
45  }
46  return $code->();
47}->(sub { IPC::Msg->new(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO) });
48
49unless (defined $msq) {
50  my $info = "IPC::Msg->new failed: $!";
51  if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
52      $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
53    plan(skip_all => $info);
54  }
55  else {
56    die $info;
57  }
58}
59
60plan(tests => 9);
61
62pass('create message queue');
63
64#Putting a message on the queue
65my $test_name = 'enqueue message';
66
67my $msgtype = 1;
68my $msg = "hello";
69if ($msq->snd($msgtype,$msg,IPC_NOWAIT)) {
70  pass($test_name);
71}
72else {
73  print "# snd: $!\n";
74  fail($test_name);
75}
76
77#Check if there are messages on the queue
78my $ds = $msq->stat;
79ok($ds, 'stat');
80
81if ($ds) {
82  is($ds->qnum, 1, 'qnum');
83}
84else {
85  fail('qnum');
86}
87
88#Retrieving a message from the queue
89my $rmsg;
90my $rmsgtype = 0; # Give me any type
91$rmsgtype = $msq->rcv($rmsg,256,$rmsgtype,IPC_NOWAIT);
92is($rmsgtype, $msgtype, 'rmsgtype');
93is($rmsg, $msg, 'rmsg');
94
95$ds = $msq->stat;
96ok($ds, 'stat');
97
98if ($ds) {
99  is($ds->qnum, 0, 'qnum');
100}
101else {
102  fail('qnum');
103}
104
105END {
106  ok($msq->remove, 'remove message') if defined $msq;
107}
108