*ctl: ensure the ARG parameter's UTF-8 flag is reset

If the SV supplied as ARG had the SVf_UTF8 flag on it would be left
on, which would effectively corrupt the returned buffer.

Only tested with shmctl(), since the other *ctl() functions only have
more complex structures with indeterminate types that would require
more effort to test.

diff --git a/doio.c b/doio.c
index 2bffeea..11c9ed1 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -3058,6 +3058,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
     if (getinfo && ret >= 0) {
        SvCUR_set(astr, infosize);
        *SvEND(astr) = '\0';
+        SvUTF8_off(astr);
        SvSETMAGIC(astr);
     }
     return ret;

diff --git a/t/io/sem.t b/t/io/sem.t
index 7a911fc..8d2c7bb 100644 (file)
--- a/t/io/sem.t
+++ b/t/io/sem.t
@@ -42,7 +42,7 @@ if (not defined $id) {
     }
 }
 else {
-    plan(tests => 7);
+    plan(tests => 9);
     pass('acquired semaphore');
 }
 
@@ -51,7 +51,7 @@ else {
        "Initialize all $nsem semaphores to zero");
 
     my $sem2set = 3;
-    my $semval = 17;
+    my $semval = 192;
     ok(semctl($id, $sem2set, SETVAL, $semval),
        "Set semaphore $sem2set to $semval");
 
@@ -68,5 +68,13 @@ else {
 
     is(semctl($id, $sem2set, GETVAL, "ignored"), $semval,
        "Check value via GETVAL");
+
+    # check utf-8 flag handling
+    utf8::upgrade($semvals);
+    ok(semctl($id, $ignored, GETALL, $semvals),
+       "fetch into an already UTF-8 buffer");
+    @semvals = unpack("s!*", $semvals);
+    is($semvals[$sem2set], $semval,
+       "Checking value of semaphore $sem2set after fetch into originally UTF-8 buffer");
 }