This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix UTF-8 handling for semop()
authorTony Cook <tony@develop-help.com>
Tue, 17 Nov 2020 23:27:50 +0000 (10:27 +1100)
committerTony Cook <tony@develop-help.com>
Tue, 24 Nov 2020 02:35:21 +0000 (13:35 +1100)
As with semctl(), the UTF-8 flag on the passed in opstring was ignored,
which meant that the upgraded version of the same string would
cause an error.

Just use SvPVbyte().

doio.c
t/io/sem.t

diff --git a/doio.c b/doio.c
index bc59c17..00f7168 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -3162,7 +3162,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
     STRLEN opsize;
     const I32 id = SvIVx(*++mark);
     SV * const opstr = *++mark;
-    const char * const opbuf = SvPV_const(opstr, opsize);
+    const char * const opbuf = SvPVbyte(opstr, opsize);
 
     PERL_ARGS_ASSERT_DO_SEMOP;
     PERL_UNUSED_ARG(sp);
index 7be1c18..bfac1c8 100644 (file)
@@ -44,7 +44,7 @@ if (not defined $id) {
     }
 }
 else {
-    plan(tests => 15);
+    plan(tests => 22);
     pass('acquired semaphore');
 }
 
@@ -99,6 +99,28 @@ $SIG{__WARN__} = sub { push @warnings, "@_"; print STDERR @_; };
     ok(!eval { semctl($id, $ignored, SETALL, $semvals); 1 },
        "throws on code points above 0xff");
     like($@, qr/Wide character/, "with the expected error");
+
+    {
+        # semop tests
+        ok(semctl($id, $sem2set, SETVAL, 0),
+           "reset our working entry");
+        # sanity check without UTF-8
+        my $op = pack "s!*", $sem2set, $semval, 0;
+        ok(semop($id, $op), "add to entry $sem2set");
+        is(semctl($id, $sem2set, GETVAL, 0), $semval,
+           "check it added to the entry");
+        utf8::upgrade($op);
+        # unlike semctl this doesn't throw on a bad size, so we don't need an
+        # eval with the buggy code
+        ok(semop($id, $op), "add more to entry $sem2set (UTF-8)");
+        is(semctl($id, $sem2set, GETVAL, 0), $semval*2,
+           "check it added to the entry");
+
+        substr($op, 0, 1) = chr(0x101);
+        ok(!eval { semop($id, $op); 1 },
+           "test semop throws if the op string isn't 'bytes'");
+        like($@, qr/Wide character/, "with the expected error");
+    }
 }
 
 {