Make sprintf "%1s" and "%.1s" call overloading once

Calling overloading multiple times can probably result in mangled
UTF8, but it is much easier just to test for the number of calls.

diff --git a/sv.c b/sv.c
index c446fba..774154c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10532,16 +10532,17 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                if (DO_UTF8(argsv)) {
                    STRLEN old_precis = precis;
                    if (has_precis && precis < elen) {
-                       STRLEN ulen = sv_len_utf8_nomg(argsv);
+                       STRLEN ulen = sv_or_pv_len_utf8(argsv, eptr, elen);
                        STRLEN p = precis > ulen ? ulen : precis;
-                       precis = sv_pos_u2b_flags(argsv, p, 0, 0);
+                       precis = sv_or_pv_pos_u2b(argsv, eptr, p, 0);
                                                        /* sticks at end */
                    }
                    if (width) { /* fudge width (can't fudge elen) */
                        if (has_precis && precis < elen)
                            width += precis - old_precis;
                        else
-                           width += elen - sv_len_utf8_nomg(argsv);
+                           width +=
+                               elen - sv_or_pv_len_utf8(argsv,eptr,elen);
                    }
                    is_utf8 = TRUE;
                }

diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 2e847ce..d914de0 100644 (file)
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -8,7 +8,7 @@ BEGIN {
     require './test.pl';
 }   
 
-plan tests => 1368;
+plan tests => 1370;
 
 use strict;
 use Config;
@@ -182,3 +182,12 @@ for my $width (1,2,3,4,5,6,7) {
         );
     }
 }
+
+# Overload count
+package o { use overload '""', sub { ++our $count; $_[0][0]; } }
+my $o = bless ["\x{100}"], o::;
+() = sprintf "%1s", $o;
+is $o::count, '1', 'sprinf %1s overload count';
+$o::count = 0;
+() = sprintf "%.1s", $o;
+is $o::count, '1', 'sprinf %.1s overload count';