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

overloading.

p4raw-id: //depot/perl@28030

2 files changed, 20 insertions, 2 deletions

diff --git a/pp_pack.c b/pp_pack.c
index 97e22fde02..6e11eb2c3e 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 ca63b44a27..68a65e8df3 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': $!";
 }