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 (file)
--- 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) {
                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;
                    }
                        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:
            }
 
        string:

-           if (has_precis && elen > precis)
+           if (has_precis && precis < elen)

                elen = precis;
            break;
 
                elen = precis;
            break;
 

diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 2e225c8..ed26c54 100644 (file)
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }   
 
     require './test.pl';
 }   
 

-plan tests => 1319;
+plan tests => 1368;

 
 use strict;
 use Config;
 
 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}"),
+        );
+    }
+}