summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorWolfgang Laun <Wolfgang.Laun@alcatel.at>2001-11-21 11:23:16 +0100
committerJarkko Hietaniemi <jhi@iki.fi>2001-11-21 13:52:30 +0000
commitb81060d6a6f72d4d81c48e5d8d024423810b6ce8 (patch)
treecb8dfcc6984206c265db9d58e3273486b623581d
parent0a7c7f4fca760548390159c148b40caeb4e5a91d (diff)
downloadperl-b81060d6a6f72d4d81c48e5d8d024423810b6ce8.tar.gz
Z*/[AZa]* fails to pack length properly
Message-ID: <200111211023160020.0050BD28@smtp.chello.at> p4raw-id: //depot/perl@13163
-rw-r--r--pp_pack.c2
-rwxr-xr-xt/op/pack.t21
2 files changed, 21 insertions, 2 deletions
diff --git a/pp_pack.c b/pp_pack.c
index 021c35c737..705ee12fc7 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 d0442034b2..5107510502 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);
+}