From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 11 Dec 2005 22:37:40 +0000 (+0000)
Subject: Fix *printf %*vd with mixed Latin 1/UTF-8. (Fixes bug 37889)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=640283f5813252b086f0011a9256515389d5b6a6;p=p5sagit%2Fp5-mst-13.2.git

Fix *printf %*vd with mixed Latin 1/UTF-8. (Fixes bug 37889)

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

diff --git a/sv.c b/sv.c
index f48e886..df957d5 100644
--- a/sv.c
+++ b/sv.c
@@ -7984,8 +7984,16 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		    vecsv = svix < svmax ? svargs[svix++] : &PL_sv_undef;
 		}
 		dotstr = SvPV_const(vecsv, dotstrlen);
+		/* Keep the DO_UTF8 test *after* the SvPV call, else things go
+		   bad with tied or overloaded values that return UTF8.  */
 		if (DO_UTF8(vecsv))
 		    is_utf8 = TRUE;
+		else if (has_utf8) {
+		    vecsv = sv_mortalcopy(vecsv);
+		    sv_utf8_upgrade(vecsv);
+		    dotstr = SvPV_const(vecsv, dotstrlen);
+		    is_utf8 = TRUE;
+		}		    
 	    }
 	    if (args) {
 		VECTORIZE_ARGS
diff --git a/t/uni/sprintf.t b/t/uni/sprintf.t
index 3c5f574..0862649 100644
--- a/t/uni/sprintf.t
+++ b/t/uni/sprintf.t
@@ -6,7 +6,7 @@ BEGIN {
     require "test.pl";
 }
 
-plan tests => 25;
+plan tests => 52;
 
 $a = "B\x{fc}f";
 $b = "G\x{100}r";
@@ -137,3 +137,19 @@ $c = 0x200;
     $sprintf = sprintf "%s%s", $w, "$w\x{100}";    
     is(substr($sprintf,0,2), $w, "utf8 echo echo");
 }
+
+my @values =(chr 110, chr 255, chr 256);
+
+foreach my $prefix (@values) {
+    foreach my $vector (map {$_ . $_} @values) {
+
+	my $format = "$prefix%*vd";
+
+	foreach my $dot (@values) {
+	    my $result = sprintf $format, $dot, $vector;
+	    is (length $result, 8)
+		or print "# ", join (',', map {ord $_} $prefix, $dot, $vector),
+		  "\n";
+	}
+    }
+}