This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix for missed accounting for null byte in pack("Z",...) (from
authorGurusamy Sarathy <gsar@cpan.org>
Fri, 28 Apr 2000 09:33:26 +0000 (09:33 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Fri, 28 Apr 2000 09:33:26 +0000 (09:33 +0000)
M.J.T. Guy)

p4raw-id: //depot/perl@5994

pp.c
t/op/pack.t

diff --git a/pp.c b/pp.c
index e90b538..17824bd 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4438,7 +4438,8 @@ PP(pp_pack)
            if ((*pat != 'a' && *pat != 'A' && *pat != 'Z') || pat[1] != '*')
                DIE(aTHX_ "/ must be followed by a*, A* or Z*");
            lengthcode = sv_2mortal(newSViv(sv_len(items > 0
-                                                  ? *MARK : &PL_sv_no)));
+                                                  ? *MARK : &PL_sv_no)
+                                            + (*pat == 'Z' ? 1 : 0)));
        }
        switch(datumtype) {
        default:
index b336cb5..dda1cc7 100755 (executable)
@@ -372,8 +372,9 @@ print $@ eq '' && $y eq 'z' ? "ok $test\n" : "not ok $test\n"; $test++;
 
 eval { ($x) = pack '/a*','hello' };
 print 'not ' unless $@; print "ok $test\n"; $test++;
-$z = pack 'n/a* w/A*','string','etc';
-print 'not ' unless $z eq "\000\006string\003etc"; print "ok $test\n"; $test++;
+$z = pack 'n/a* N/Z* w/A*','string','hi there ','etc';
+print 'not ' unless $z eq "\000\006string\0\0\0\012hi there \000\003etc";
+print "ok $test\n"; $test++;
 
 eval { ($x) = unpack 'a/a*/a*', '212ab345678901234567' };
 print $@ eq '' && $x eq 'ab3456789012' ? "ok $test\n" : "#$x,$@\nnot ok $test\n";