diff options
| -rw-r--r-- | pp.c | 13 | ||||
| -rwxr-xr-x | t/op/pack.t | 18 |
2 files changed, 23 insertions, 8 deletions
@@ -3264,6 +3264,7 @@ PP(pp_unpack) register U32 culong; NV cdouble; int commas = 0; + int star; #ifdef PERL_NATINT_PACK int natint; /* native integer */ int unatint; /* unsigned native integer */ @@ -3305,11 +3306,13 @@ PP(pp_unpack) else DIE(aTHX_ "'!' allowed only after types %s", natstr); } + star = 0; if (pat >= patend) len = 1; else if (*pat == '*') { len = strend - strbeg; /* long enough */ pat++; + star = 1; } else if (isDIGIT(*pat)) { len = *pat++ - '0'; @@ -3321,6 +3324,7 @@ PP(pp_unpack) } else len = (datumtype != '@'); + redo_switch: switch(datumtype) { default: DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype); @@ -3356,15 +3360,14 @@ PP(pp_unpack) case '/': if (oldsp >= SP) DIE(aTHX_ "/ must follow a numeric type"); - if (*pat != 'a' && *pat != 'A' && *pat != 'Z') - DIE(aTHX_ "/ must be followed by a, A or Z"); datumtype = *pat++; if (*pat == '*') pat++; /* ignore '*' for compatibility with pack */ if (isDIGIT(*pat)) DIE(aTHX_ "/ cannot take a count" ); len = POPi; - /* drop through */ + star = 0; + goto redo_switch; case 'A': case 'Z': case 'a': @@ -3395,7 +3398,7 @@ PP(pp_unpack) break; case 'B': case 'b': - if (pat[-1] == '*' || len > (strend - s) * 8) + if (star || len > (strend - s) * 8) len = (strend - s) * 8; if (checksum) { if (!PL_bitcount) { @@ -3463,7 +3466,7 @@ PP(pp_unpack) break; case 'H': case 'h': - if (pat[-1] == '*' || len > (strend - s) * 2) + if (star || len > (strend - s) * 2) len = (strend - s) * 2; sv = NEWSV(35, len + 1); SvCUR_set(sv, len); diff --git a/t/op/pack.t b/t/op/pack.t index 9b96289497..11ada3905d 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -6,7 +6,7 @@ BEGIN { require Config; import Config; } -print "1..153\n"; +print "1..156\n"; $format = "c2 x5 C C x s d i l a6"; # Need the expression in here to force ary[5] to be numeric. This avoids @@ -357,7 +357,7 @@ print "ok ", $test++, "\n"; print "not " unless pack("V", 0xdeadbeef) eq "\xef\xbe\xad\xde"; print "ok ", $test++, "\n"; -# 144..149: / +# 144..152: / my $z; eval { ($x) = unpack '/a*','hello' }; @@ -372,7 +372,19 @@ 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++; -# 150..153: / with # +eval { ($x) = unpack 'a/a*/a*', '212ab345678901234567' }; +print $@ eq '' && $x eq 'ab3456789012' ? "ok $test\n" : "#$x,$@\nnot ok $test\n"; +$test++; + +eval { ($x) = unpack 'a/a*/a*', '3012ab345678901234567' }; +print $@ eq '' && $x eq 'ab3456789012' ? "ok $test\n" : "not ok $test\n"; +$test++; + +eval { ($x) = unpack 'a/a*/b*', '212ab' }; +print $@ eq '' && $x eq '100001100100' ? "ok $test\n" : "#$x,$@\nnot ok $test\n"; +$test++; + +# 153..156: / with # eval { ($z,$x,$y) = unpack <<EOU, "003ok \003yes\004z\000abc" }; a3/A # Count in ASCII |