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