From: Ton Hospel <perl5-porters@ton.iguana.be>
Date: Mon, 21 Mar 2005 21:31:37 +0000 (+0000)
Subject: Re: unpack A strip patch
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=18bdf90ade8cd9b8918f6edac90115b5fbbe6fd3;p=p5sagit%2Fp5-mst-13.2.git

Re: unpack A strip patch
Message-Id: <d1nefp$lpe$1@post.home.lunix>

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

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 9785a25..a7eaece 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
diff --git a/pp_pack.c b/pp_pack.c
index 1b56392..45eabb2 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -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 3009510..08cf811 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');
+}