From: Alex Vandiver Date: Fri, 29 May 2009 20:21:22 +0000 (-0400) Subject: Fix [RT#6266] -- sv_pos_u2b expects to be called with a valid character index X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ef5ed94af;p=p5sagit%2Fp5-mst-13.2.git Fix [RT#6266] -- sv_pos_u2b expects to be called with a valid character index sv_pos_u2b, when utf8 position caching is enabled, treats the uoffset it is given as real, storing it away for lature use. sprintf, here, passes the byte length of the string, which causes an invalid offset to be cached. --- diff --git a/sv.c b/sv.c index 9944724..f52d83e 100644 --- a/sv.c +++ b/sv.c @@ -9676,7 +9676,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen, if (DO_UTF8(argsv)) { I32 old_precis = precis; if (has_precis && precis < elen) { - I32 p = precis; + I32 ulen = sv_len_utf8(argsv); + I32 p = precis > ulen ? ulen : precis; sv_pos_u2b(argsv, &p, 0); /* sticks at end */ precis = p; } @@ -9691,7 +9692,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen, } string: - if (has_precis && elen > precis) + if (has_precis && precis < elen) elen = precis; break; diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t index 2e225c8..ed26c54 100644 --- a/t/op/sprintf2.t +++ b/t/op/sprintf2.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 1319; +plan tests => 1368; use strict; use Config; @@ -165,3 +165,18 @@ for my $t (@tests) { } } +# Check unicode vs byte length +for my $width (1,2,3,4,5,6,7) { + for my $precis (1,2,3,4,5,6,7) { + my $v = "\x{20ac}\x{20ac}"; + my $format = "%" . $width . "." . $precis . "s"; + my $chars = ($precis > 2 ? 2 : $precis); + my $space = ($width < 2 ? 0 : $width - $chars); + fresh_perl_is( + 'my $v = "\x{20ac}\x{20ac}"; my $x = sprintf "'.$format.'", $v; $x =~ /^(\s*)(\S*)$/; print "$_" for map {length} $1, $2', + "$space$chars", + {}, + q(sprintf ").$format.q(", "\x{20ac}\x{20ac}"), + ); + } +}