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 (file)
--- 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 (file)
--- 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";
+       }
+    }
+}