[perl #40473] sprintf width+precision fails on wide chars
authorAnatoly Vorobey <unknown>
Sun, 8 Oct 2006 17:58:16 +0000 (10:58 -0700)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Tue, 10 Oct 2006 14:36:49 +0000 (14:36 +0000)
From: Anatoly Vorobey (via RT) <perlbug-followup@perl.org>
Message-ID: <rt-3.5.HEAD-31259-1160355496-1702.40473-75-0@perl.org>

p4raw-id: //depot/perl@28985

sv.c
t/op/sprintf2.t

diff --git a/sv.c b/sv.c
index 4fa4498..7dd83cc 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8919,13 +8919,17 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            else {
                eptr = SvPVx_const(argsv, elen);
                if (DO_UTF8(argsv)) {
+                   I32 old_precis = precis;
                    if (has_precis && precis < elen) {
                        I32 p = precis;
                        sv_pos_u2b(argsv, &p, 0); /* sticks at end */
                        precis = p;
                    }
                    if (width) { /* fudge width (can't fudge elen) */
-                       width += elen - sv_len_utf8(argsv);
+                       if (has_precis && precis < elen)
+                           width += precis - old_precis;
+                       else
+                           width += elen - sv_len_utf8(argsv);
                    }
                    is_utf8 = TRUE;
                }
index 81450ce..90214ab 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }   
 
-plan tests => 280;
+plan tests => 284;
 
 is(
     sprintf("%.40g ",0.01),
@@ -28,6 +28,15 @@ for my $i (1, 5, 10, 20, 50, 100) {
        "width calculation under utf8 upgrade, length=$i");
 }
 
+# check simultaneous width & precision with wide characters
+for my $i (1, 3, 5, 10) {
+    my $string = "\x{0410}"x($i+10);   # cyrillic capital A
+    my $expect = "\x{0410}"x$i;        # cut down to exactly $i characters
+    my $format = "%$i.${i}s";
+    is(sprintf($format, $string), $expect,
+       "width & precision interplay with utf8 strings, length=$i");
+}
+
 # Used to mangle PL_sv_undef
 fresh_perl_is(
     'print sprintf "xxx%n\n"; print undef',