From: Marcus Holland-Moritz <mhx-perl@gmx.net>
Date: Sun, 9 Nov 2008 13:42:58 +0000 (+0000)
Subject: Fix warning code in Perl_sv_vcatpvfn() to make the TODO
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1d1ac7bc98334889587f2985125658b93a408866;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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");
   }
 }