From: Ton Hospel <perl5-porters@ton.iguana.be>
Date: Sat, 29 Jan 2005 12:54:34 +0000 (+0000)
Subject: Re: encoding neutral unpack
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=21c16052ffb70c4bff066e455c6d4bea74622e34;p=p5sagit%2Fp5-mst-13.2.git

Re: encoding neutral unpack
From: perl5-porters[at]ton.iguana.be (Ton Hospel)
Message-ID: <ctg12a$j0e$2[at]post.home.lunix>

Counted length prefixes shouldn't change C0/U0 mode
in pack/unpack (plus a regression test)

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

diff --git a/pp_pack.c b/pp_pack.c
index cf020d6..3ee7128 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -908,6 +908,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
     const int bits_in_uv = 8 * sizeof(cuv);
     char* strrelbeg = s;
     bool beyond = FALSE;
+    bool explicit_length;
     bool unpack_only_one = (symptr->flags & FLAG_UNPACK_ONLY_ONE) != 0;
 
     while (next_symbol(symptr)) {
@@ -930,6 +931,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
 	    break;
         }
 
+        explicit_length = TRUE;
       redo_switch:
         beyond = s >= strend;
 	{
@@ -1180,7 +1182,8 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
 	case 'C':
 	unpack_C: /* unpack U will jump here if not UTF-8 */
             if (len == 0) {
-                symptr->flags &= ~FLAG_UNPACK_DO_UTF8;
+                if (explicit_length) 
+                    symptr->flags &= ~FLAG_UNPACK_DO_UTF8;
 		break;
 	    }
 	    if (checksum) {
@@ -1202,7 +1205,8 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
 	    break;
 	case 'U':
 	    if (len == 0) {
-                symptr->flags |= FLAG_UNPACK_DO_UTF8;
+                if (explicit_length) 
+                    symptr->flags |= FLAG_UNPACK_DO_UTF8;
 		break;
 	    }
 	    if ((symptr->flags & FLAG_UNPACK_DO_UTF8) == 0)
@@ -1753,6 +1757,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
 		Perl_croak(aTHX_ "Code missing after '/' in unpack" );
             }
             datumtype = symptr->code;
+            explicit_length = FALSE;
 	    goto redo_switch;
         }
     }
diff --git a/t/op/pack.t b/t/op/pack.t
index 701b7b0..e51cc47 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 => 13859;
+plan tests => 13863;
 
 use strict;
 use warnings;
@@ -1509,3 +1509,12 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
     is($x[0], 'b', 'before scope');
     is($x[1], 225, 'after scope');
 }
+
+{
+    # counted length prefixes shouldn't change C0/U0 mode
+    # (note the length is actually 0 in this test)
+    is(join(',', unpack("aC/UU",   "b\0\341\277\274")), 'b,225');
+    is(join(',', unpack("aC/CU",   "b\0\341\277\274")), 'b,225');
+    is(join(',', unpack("aU0C/UU", "b\0\341\277\274")), 'b,8188');
+    is(join(',', unpack("aU0C/CU", "b\0\341\277\274")), 'b,8188');
+}