Commit | Line | Data |
8f85282b |
1 | ################################################################################ |
2 | # |
503ba33a |
3 | # $Revision: 11 $ |
8f85282b |
4 | # $Author: mhx $ |
503ba33a |
5 | # $Date: 2008/11/28 18:08:11 +0100 $ |
8f85282b |
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 | |
72802890 |
17 | BEGIN { |
8f85282b |
18 | if ($ENV{'PERL_CORE'}) { |
6edcbe38 |
19 | chdir 't' if -d 't'; |
8f85282b |
20 | @INC = '../lib' if -d '../lib' && -d '../ext'; |
21 | } |
6edcbe38 |
22 | |
8f85282b |
23 | require Test::More; import Test::More; |
24 | require Config; import Config; |
6edcbe38 |
25 | |
8f85282b |
26 | if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) { |
27 | plan(skip_all => 'IPC::SysV was not built'); |
28 | } |
29 | } |
6edcbe38 |
30 | |
8f85282b |
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'); |
72802890 |
35 | } |
36 | |
0ade1984 |
37 | use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_STAT S_IRWXU S_IRWXG S_IRWXO); |
8f85282b |
38 | use strict; |
0ade1984 |
39 | |
40 | use IPC::Msg; |
41 | #Creating a message queue |
42 | |
8f85282b |
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: $!"; |
503ba33a |
54 | if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS || |
55 | $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) { |
8f85282b |
56 | plan(skip_all => $info); |
57 | } |
58 | else { |
59 | die $info; |
60 | } |
61 | } |
0ade1984 |
62 | |
8f85282b |
63 | plan(tests => 9); |
64 | |
65 | pass('create message queue'); |
0ade1984 |
66 | |
67 | #Putting a message on the queue |
8f85282b |
68 | my $test_name = 'enqueue message'; |
0ade1984 |
69 | |
8f85282b |
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 | } |
0ade1984 |
79 | |
8f85282b |
80 | #Check if there are messages on the queue |
81 | my $ds = $msq->stat; |
82 | ok($ds, 'stat'); |
0ade1984 |
83 | |
8f85282b |
84 | if ($ds) { |
85 | is($ds->qnum, 1, 'qnum'); |
86 | } |
87 | else { |
88 | fail('qnum'); |
89 | } |
0ade1984 |
90 | |
8f85282b |
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'); |
0ade1984 |
97 | |
8f85282b |
98 | $ds = $msq->stat; |
99 | ok($ds, 'stat'); |
0ade1984 |
100 | |
8f85282b |
101 | if ($ds) { |
102 | is($ds->qnum, 0, 'qnum'); |
103 | } |
104 | else { |
105 | fail('qnum'); |
106 | } |
0ade1984 |
107 | |
cab0dcf9 |
108 | END { |
8f85282b |
109 | ok($msq->remove, 'remove message') if defined $msq; |
cab0dcf9 |
110 | } |