Fix warning code in Perl_sv_vcatpvfn() to make the TODO

tests introduced with #34781 pass. Add some more warning
tests to t/lib/warnings/sv.

p4raw-id: //depot/perl@34783

diff --git a/sv.c b/sv.c
index 000cfd2..436f18f 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9122,6 +9122,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
        STRLEN esignlen = 0;
 
        const char *eptr = NULL;
+       const char *fmtstart;
        STRLEN elen = 0;
        SV *vecsv = NULL;
        const U8 *vecstr = NULL;
@@ -9162,6 +9163,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
        if (q++ >= patend)
            break;
 
+       fmtstart = q;
+
 /*
     We allow format specification elements in this order:
        \d+\$              explicit format parameter index
@@ -9976,16 +9979,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
                SV * const msg = sv_newmortal();
                Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %sprintf: ",
                          (PL_op->op_type == OP_PRTF) ? "" : "s");
-               if (c) {
-                   if (isPRINT(c))
-                       Perl_sv_catpvf(aTHX_ msg,
-                                      "\"%%%c\"", c & 0xFF);
-                   else
-                       Perl_sv_catpvf(aTHX_ msg,
-                                      "\"%%\\%03"UVof"\"",
-                                      (UV)c & 0xFF);
-               } else
+               if (fmtstart < patend) {
+                   const char * const fmtend = q < patend ? q : patend;
+                   const char * f;
+                   sv_catpvs(msg, "\"%");
+                   for (f = fmtstart; f < fmtend; f++) {
+                       if (isPRINT(*f)) {
+                           sv_catpvn(msg, f, 1);
+                       } else {
+                           Perl_sv_catpvf(aTHX_ msg,
+                                          "\\%03"UVof, (UV)*f & 0xFF);
+                       }
+                   }
+                   sv_catpvs(msg, "\"");
+               } else {
                    sv_catpvs(msg, "end of string");
+               }
                Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, SVfARG(msg)); /* yes, this is reentrant */
            }
 

diff --git a/t/lib/warnings/sv b/t/lib/warnings/sv
index 1f66a8d..dbab90b 100644 (file)
--- a/t/lib/warnings/sv
+++ b/t/lib/warnings/sv
@@ -291,6 +291,16 @@ printf F "%" ;
 $a = sprintf "%" ;
 printf F "%\x02" ;
 $a = sprintf "%\x02" ;
+printf F "%llz" ;
+$a = sprintf "%llz" ;
+printf F "%25llz" ;
+$a = sprintf "%25llz" ;
+printf F "%+2Lz" ;
+$a = sprintf "%+2Lz" ;
+printf F "%+2ll" ;
+$a = sprintf "%+2ll" ;
+printf F "%+2L\x03" ;
+$a = sprintf "%+2L\x03" ;
 no warnings 'printf' ;
 printf F "%z\n" ;
 $a = sprintf "%z" ;
@@ -298,6 +308,16 @@ printf F "%" ;
 $a = sprintf "%" ;
 printf F "%\x02" ;
 $a = sprintf "%\x02" ;
+printf F "%llz" ;
+$a = sprintf "%llz" ;
+printf F "%25llz" ;
+$a = sprintf "%25llz" ;
+printf F "%+2Lz" ;
+$a = sprintf "%+2Lz" ;
+printf F "%+2ll" ;
+$a = sprintf "%+2ll" ;
+printf F "%+2L\x03" ;
+$a = sprintf "%+2L\x03" ;
 EXPECT
 Invalid conversion in printf: "%z" at - line 4.
 Invalid conversion in sprintf: "%z" at - line 5.
@@ -305,6 +325,16 @@ Invalid conversion in printf: end of string at - line 6.
 Invalid conversion in sprintf: end of string at - line 7.
 Invalid conversion in printf: "%\002" at - line 8.
 Invalid conversion in sprintf: "%\002" at - line 9.
+Invalid conversion in printf: "%llz" at - line 10.
+Invalid conversion in sprintf: "%llz" at - line 11.
+Invalid conversion in printf: "%25llz" at - line 12.
+Invalid conversion in sprintf: "%25llz" at - line 13.
+Invalid conversion in printf: "%+2Lz" at - line 14.
+Invalid conversion in sprintf: "%+2Lz" at - line 15.
+Invalid conversion in printf: "%+2ll" at - line 16.
+Invalid conversion in sprintf: "%+2ll" at - line 17.
+Invalid conversion in printf: "%+2L\003" at - line 18.
+Invalid conversion in sprintf: "%+2L\003" at - line 19.
 ########
 # sv.c
 use warnings 'misc' ;

diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index c27df06..2e225c8 100644 (file)
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -161,10 +161,7 @@ for my $t (@tests) {
   for my $num (@$nums) {
     my $w; local $SIG{__WARN__} = sub { $w = shift };
     is(sprintf($fmt, $num), $Q ? $num : $fmt, "quad: $fmt -> $num");
-    {
-      local our $TODO = $Q ? "" : "warning doesn't contain length modifiers";
-      like($w, $Q ? '' : qr/Invalid conversion in sprintf: "$fmt"/, "warning: $fmt");
-    }
+    like($w, $Q ? '' : qr/Invalid conversion in sprintf: "$fmt"/, "warning: $fmt");
   }
 }