[perl #34062] pack Z0 destroys the character before

From: perl-5.8.0@ton.iguana.be (via RT) <perlbug-followup@perl.org>
Message-ID: <rt-3.0.11-34062-107199.19.360569328007@perl.org>
(plus a regression test)

p4raw-id: //depot/perl@23946

diff --git a/pp_pack.c b/pp_pack.c
index 3ee7128..690cd35 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2107,7 +2107,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            }
            if ((I32)fromlen >= len) {
                sv_catpvn(cat, aptr, len);
-               if (datumtype == 'Z')
+               if (datumtype == 'Z' && len > 0)
                    *(SvEND(cat)-1) = '\0';
            }
            else {

diff --git a/t/op/pack.t b/t/op/pack.t
index e51cc47..3255806 100755 (executable)
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
 my $no_signedness = $] > 5.009 ? '' :
   "Signed/unsigned pack modifiers not available on this perl";
 
-plan tests => 13863;
+plan tests => 13864;
 
 use strict;
 use warnings;
@@ -1518,3 +1518,9 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
     is(join(',', unpack("aU0C/UU", "b\0\341\277\274")), 'b,8188');
     is(join(',', unpack("aU0C/CU", "b\0\341\277\274")), 'b,8188');
 }
+
+{
+    # "Z0" (bug #34062)
+    my (@x) = unpack("C*", pack("CZ0", 1, "b"));
+    is(join(',', @x), '1', 'pack Z0 doesn\'t destroy the character before');
+}