From: Wolfgang Laun <Wolfgang.Laun@alcatel.at>
Date: Wed, 21 Nov 2001 10:23:16 +0000 (+0100)
Subject: Z*/[AZa]* fails to pack length properly
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b81060d6a6f72d4d81c48e5d8d024423810b6ce8;p=p5sagit%2Fp5-mst-13.2.git

Z*/[AZa]* fails to pack length properly
Message-ID: <200111211023160020.0050BD28@smtp.chello.at>

p4raw-id: //depot/perl@13163
---

diff --git a/pp_pack.c b/pp_pack.c
index 021c35c..705ee12 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1386,7 +1386,7 @@ PP(pp_pack)
 	case 'a':
 	    fromstr = NEXTFROM;
 	    aptr = SvPV(fromstr, fromlen);
-	    if (pat[-1] == '*') {
+	    if (pat[lengthcode ? -2 : -1] == '*') { /* -2 after '/' */  
 		len = fromlen;
 		if (datumtype == 'Z')
 		    ++len;
diff --git a/t/op/pack.t b/t/op/pack.t
index d044203..5107510 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -1,6 +1,6 @@
 #!./perl -w
 
-print "1..613\n";
+print "1..614\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -676,3 +676,22 @@ foreach (
 
     ok(scalar unpack("w/a*", "\x02abc") eq "ab");
 }
+
+{
+    # 614
+    
+    # from Wolfgang Laun: fix in change #13163
+
+    my $s = 'ABC' x 10;
+    my $x = 42;
+    my $buf = pack( 'Z*/A* C',  $s, $x );
+    my $y;
+
+    my $h = $buf;
+    $h =~ s/[^[:print:]]/./g;
+    ( $s, $y ) = unpack( "Z*/A* C", $buf );
+    ok($h eq "30.ABCABCABCABCABCABCABCABCABCABC*" &&
+       length $buf == 34 &&
+       $s eq "ABCABCABCABCABCABCABCABCABCABC" &
+       $y == 42);
+}