diff options
| -rw-r--r-- | pod/perlfunc.pod | 2 | ||||
| -rw-r--r-- | pp_pack.c | 16 | ||||
| -rwxr-xr-x | t/op/pack.t | 17 |
3 files changed, 30 insertions, 5 deletions
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 9785a250c6..a7eaece801 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3425,7 +3425,7 @@ count should not be more than 65. The C<a>, C<A>, and C<Z> types gobble just one value, but pack it as a string of length count, padding with nulls or spaces as necessary. When -unpacking, C<A> strips trailing spaces and nulls, C<Z> strips everything +unpacking, C<A> strips trailing whitespace and nulls, C<Z> strips everything after the first null, and C<a> returns data verbatim. If the value-to-pack is too long, it is truncated. If too long and an @@ -1373,9 +1373,19 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char } else if (datumtype == 'A') { /* 'A' strips both nulls and spaces */ char *ptr; - for (ptr = s+len-1; ptr >= s; ptr--) - if (*ptr != 0 && !isSPACE(*ptr)) break; - ptr++; + if (utf8 && (symptr->flags & FLAG_WAS_UTF8)) { + for (ptr = s+len-1; ptr >= s; ptr--) + if (*ptr != 0 && !UTF8_IS_CONTINUATION(*ptr) && + !is_utf8_space(ptr)) break; + if (ptr >= s) ptr += UTF8SKIP(ptr); + else ptr++; + if (ptr > s+len) + Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); + } else { + for (ptr = s+len-1; ptr >= s; ptr--) + if (*ptr != 0 && !isSPACE(*ptr)) break; + ptr++; + } sv = newSVpvn(s, ptr-s); } else sv = newSVpvn(s, len); diff --git a/t/op/pack.t b/t/op/pack.t index 3009510a13..08cf811138 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' : my $no_signedness = $] > 5.009 ? '' : "Signed/unsigned pack modifiers not available on this perl"; -plan tests => 14621; +plan tests => 14627; use strict; use warnings; @@ -1807,3 +1807,18 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_ is(pack("Z*/Z", ""), "1\0\0", "pack Z*/Z makes an extended string"); is(pack("Z*/a", ""), "0\0", "pack Z*/a makes an extended string"); } +{ + # unpack("A*", $unicode) strips general unicode spaces + is(unpack("A*", "ab \n\xa0 \0"), "ab \n\xa0", + 'normal A* strip leaves \xa0'); + is(unpack("U0C0A*", "ab \n\xa0 \0"), "ab \n\xa0", + 'normal A* strip leaves \xa0 even if it got upgraded for technical reasons'); + is(unpack("A*", pack("a*(U0U)a*", "ab \n", 0xa0, " \0")), "ab", + 'upgraded strings A* removes \xa0'); + is(unpack("A*", pack("a*(U0UU)a*", "ab \n", 0xa0, 0x1680, " \0")), "ab", + 'upgraded strings A* removes all unicode whitespace'); + is(unpack("A5", pack("a*(U0U)a*", "ab \n", 0x1680, "def", "ab")), "ab", + 'upgraded strings A5 removes all unicode whitespace'); + is(unpack("A*", pack("U", 0x1680)), "", + 'upgraded strings A* with nothing left'); +} |