From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 30 Apr 2006 20:41:29 +0000 (+0000)
Subject: One part of pp_pack couldn't correctly handle surprises from UTF-8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ce399ba62db9cda174a31da7c5310c71b8a9adc4;p=p5sagit%2Fp5-mst-13.2.git

One part of pp_pack couldn't correctly handle surprises from UTF-8
overloading.

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

diff --git a/pp_pack.c b/pp_pack.c
index 97e22fd..6e11eb2 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2544,9 +2544,20 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    if (strchr("aAZ", lookahead.code)) {
 		if (lookahead.howlen == e_number) count = lookahead.length;
 		else {
-		    if (items > 0)
+		    if (items > 0) {
+			if (SvGAMAGIC(*beglist)) {
+			    /* Avoid reading the active data more than once
+			       by copying it to a temporary.  */
+			    STRLEN len;
+			    const char *const pv = SvPV_const(*beglist, len);
+			    SV *const temp = sv_2mortal(newSVpvn(pv, len));
+			    if (SvUTF8(*beglist))
+				SvUTF8_on(temp);
+			    *beglist = temp;
+			}
 			count = DO_UTF8(*beglist) ?
 			    sv_len_utf8(*beglist) : sv_len(*beglist);
+		    }
 		    else count = 0;
 		    if (lookahead.code == 'Z') count++;
 		}
diff --git a/t/uni/overload.t b/t/uni/overload.t
index ca63b44..68a65e8 100644
--- a/t/uni/overload.t
+++ b/t/uni/overload.t
@@ -7,7 +7,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 202;
+use Test::More tests => 208;
 
 package UTF8Toggle;
 use strict;
@@ -254,6 +254,13 @@ foreach my $pieces ($bits, UTF8Toggle->new($bits)) {
     like ($pieces ^ $bits, qr/\A\0+\z/, "something xor itself is zeros");
 }
 
+foreach my $value ("\243", UTF8Toggle->new("\243")) {
+    is (pack ("A/A", $value), pack ("A/A", "\243"),
+	"pack copes with overloading");
+    is (pack ("A/A", $value), pack ("A/A", "\243"));
+    is (pack ("A/A", $value), pack ("A/A", "\243"));
+}
+
 END {
     1 while -f $tmpfile and unlink $tmpfile || die "unlink '$tmpfile': $!";
 }