unpack("Z*Z*", pack("Z*Z*", ..)) bug, patch and test from

Wolfgang Laun <Wolfgang.Laun@alcatel.at>

p4raw-id: //depot/perl@12180

diff --git a/pp_pack.c b/pp_pack.c
index ff2f8e0..021c35c 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -266,13 +266,14 @@ PP(pp_unpack)
                goto uchar_checksum;
            sv = NEWSV(35, len);
            sv_setpvn(sv, s, len);
-           s += len;
            if (datumtype == 'A' || datumtype == 'Z') {
                aptr = s;       /* borrow register */
                if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
                    s = SvPVX(sv);
                    while (*s)
                        s++;
+                   if (star) /* exact for 'Z*' */
+                       len = s - SvPVX(sv) + 1;
                }
                else {          /* 'A' strips both nulls and spaces */
                    s = SvPVX(sv) + len - 1;
@@ -283,6 +284,7 @@ PP(pp_unpack)
                SvCUR_set(sv, s - SvPVX(sv));
                s = aptr;       /* unborrow register */
            }
+           s += len;
            XPUSHs(sv_2mortal(sv));
            break;
        case 'B':

diff --git a/t/op/pack.t b/t/op/pack.t
index 02b3806..6b9ceeb 100755 (executable)
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -1,6 +1,6 @@
-#!./perl -Tw
+#!./perl -w
 
-print "1..610\n";
+print "1..611\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -646,3 +646,12 @@ foreach (
     or printf "# scalar unpack ('$template', \"%s\") gave %s expected %s\n",
     encode ($in), encode_list ($got), encode_list ($out[0]);
 }
+
+{
+    # 611
+    my $t = 'Z*Z*';
+    my ($u, $v) = qw(foo xyzzy);
+    my $p = pack($t, $u, $v);
+    my @u = unpack($t, $p);
+    print @u == 2 && $u[0] eq $u && $u[1] eq $v ? "ok 611\n" : "not ok 611\n";
+}