1#!perl
2
3BEGIN {
4  chdir 't' if -d 't';
5
6  require "./test.pl";
7  set_up_inc( '../lib' ) if -d '../lib' && -d '../ext';
8  require Config; import Config;
9
10  if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
11    skip_all('-- IPC::SysV was not built');
12  }
13  skip_all_if_miniperl();
14  if ($Config{'d_msg'} ne 'define') {
15    skip_all('-- $Config{d_msg} undefined');
16  }
17}
18
19use strict;
20use warnings;
21our $TODO;
22
23use sigtrap qw/die normal-signals error-signals/;
24use IPC::SysV qw/ IPC_PRIVATE S_IRUSR S_IWUSR IPC_RMID IPC_CREAT IPC_STAT IPC_CREAT IPC_NOWAIT/;
25
26my $id;
27END { msgctl $id, IPC_RMID, 0 if defined $id }
28
29{
30    local $SIG{SYS} = sub { skip_all("SIGSYS caught") } if exists $SIG{SYS};
31    $id = msgget IPC_PRIVATE, S_IRUSR | S_IWUSR | IPC_CREAT;
32}
33
34if (not defined $id) {
35    my $info = "msgget failed: $!";
36    if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
37	$! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
38        skip_all($info);
39    }
40    else {
41        die $info;
42    }
43}
44else {
45    pass('acquired msg queue');
46}
47
48{
49    # basic send/receive
50    my $type = 0x1F0;
51    my $content = "AB\xFF\xC0";
52
53    my $msg = pack("l! a*", $type, $content);
54    if (ok(msgsnd($id, $msg, IPC_NOWAIT), "send a message")) {
55        my $rcvbuf;
56        ok(msgrcv($id, $rcvbuf, 1024, 0, IPC_NOWAIT), "receive it");
57        is($rcvbuf, $msg, "received should match sent");
58    }
59
60    # try upgraded send
61    utf8::upgrade(my $umsg = $msg);
62    if (ok(msgsnd($id, $umsg, IPC_NOWAIT), "send a message (upgraded)")) {
63        my $rcvbuf;
64        ok(msgrcv($id, $rcvbuf, 1024, 0, IPC_NOWAIT), "receive it");
65        is($rcvbuf, $msg, "received should match sent");
66    }
67
68    # try a receive buffer that starts upgraded
69    if (ok(msgsnd($id, $msg, IPC_NOWAIT), "send a message (upgraded receiver)")) {
70        my $rcvbuf = "\x{101}";
71        ok(msgrcv($id, $rcvbuf, 1024, 0, IPC_NOWAIT), "receive it (upgraded receiver)");
72        is($rcvbuf, $msg, "received should match sent (upgraded receiver)");
73    }
74}
75
76done_testing();
77