msgsnd: handle an upgraded MSG parameter correctly

diff --git a/MANIFEST b/MANIFEST
index 42eca1b..f0efee7 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5558,6 +5558,7 @@ t/io/inplace.t                    See if inplace editing works
 t/io/iofile.t                  See if we can load IO::File on demand
 t/io/iprefix.t                 See if inplace editing works with prefixes
 t/io/layers.t                  See if PerlIO layers work
+t/io/msg.t                     See if SysV message queues work
 t/io/nargv.t                   See if nested ARGV stuff works
 t/io/open.t                    See if open works
 t/io/openpid.t                 See if open works for subprocesses

diff --git a/doio.c b/doio.c
index 00f7168..aa6c35b 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -3086,7 +3086,7 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
     const I32 id = SvIVx(*++mark);
     SV * const mstr = *++mark;
     const I32 flags = SvIVx(*++mark);
-    const char * const mbuf = SvPV_const(mstr, len);
+    const char * const mbuf = SvPVbyte(mstr, len);
     const I32 msize = len - sizeof(long);
 
     PERL_ARGS_ASSERT_DO_MSGSND;

diff --git a/t/io/msg.t b/t/io/msg.t
new file mode 100644 (file)
index 0000000..c31a20b
--- /dev/null
+++ b/t/io/msg.t
@@ -0,0 +1,69 @@
+#!perl
+
+BEGIN {
+  chdir 't' if -d 't';
+
+  require "./test.pl";
+  set_up_inc( '../lib' ) if -d '../lib' && -d '../ext';
+  require Config; import Config;
+
+  if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
+    skip_all('-- IPC::SysV was not built');
+  }
+  skip_all_if_miniperl();
+  if ($Config{'d_msg'} ne 'define') {
+    skip_all('-- $Config{d_msg} undefined');
+  }
+}
+
+use strict;
+use warnings;
+our $TODO;
+
+use sigtrap qw/die normal-signals error-signals/;
+use IPC::SysV qw/ IPC_PRIVATE S_IRUSR S_IWUSR IPC_RMID IPC_CREAT IPC_STAT IPC_CREAT IPC_NOWAIT/;
+
+my $id;
+END { msgctl $id, IPC_RMID, 0 if defined $id }
+
+{
+    local $SIG{SYS} = sub { skip_all("SIGSYS caught") } if exists $SIG{SYS};
+    $id = msgget IPC_PRIVATE, S_IRUSR | S_IWUSR | IPC_CREAT;
+}
+
+if (not defined $id) {
+    my $info = "msgget failed: $!";
+    if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
+       $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
+        skip_all($info);
+    }
+    else {
+        die $info;
+    }
+}
+else {
+    pass('acquired msg queue');
+}
+
+{
+    # basic send/receive
+    my $type = 0x1F0;
+    my $content = "AB\xFF\xC0";
+
+    my $msg = pack("l! a*", $type, $content);
+    if (ok(msgsnd($id, $msg, IPC_NOWAIT), "send a message")) {
+        my $rcvbuf;
+        ok(msgrcv($id, $rcvbuf, 1024, 0, IPC_NOWAIT), "receive it");
+        is($rcvbuf, $msg, "received should match sent");
+    }
+
+    # try upgraded send
+    utf8::upgrade(my $umsg = $msg);
+    if (ok(msgsnd($id, $umsg, IPC_NOWAIT), "send a message (upgraded)")) {
+        my $rcvbuf;
+        ok(msgrcv($id, $rcvbuf, 1024, 0, IPC_NOWAIT), "receive it");
+        is($rcvbuf, $msg, "received should match sent");
+    }
+}
+
+done_testing();