Change 34783 by [EMAIL PROTECTED] on 2008/11/09 13:42:58
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.
Affected files ...
... //depot/perl/sv.c#1576 edit
... //depot/perl/t/lib/warnings/sv#12 edit
... //depot/perl/t/op/sprintf2.t#14 edit
Differences ...
==== //depot/perl/sv.c#1576 (text) ====
Index: perl/sv.c
--- perl/sv.c#1575~34780~ 2008-11-08 20:22:15.000000000 -0800
+++ perl/sv.c 2008-11-09 05:42:58.000000000 -0800
@@ -9122,6 +9122,7 @@
STRLEN esignlen = 0;
const char *eptr = NULL;
+ const char *fmtstart;
STRLEN elen = 0;
SV *vecsv = NULL;
const U8 *vecstr = NULL;
@@ -9162,6 +9163,8 @@
if (q++ >= patend)
break;
+ fmtstart = q;
+
/*
We allow format specification elements in this order:
\d+\$ explicit format parameter index
@@ -9976,16 +9979,22 @@
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 */
}
==== //depot/perl/t/lib/warnings/sv#12 (text) ====
Index: perl/t/lib/warnings/sv
--- perl/t/lib/warnings/sv#11~26236~ 2005-12-01 03:52:24.000000000 -0800
+++ perl/t/lib/warnings/sv 2008-11-09 05:42:58.000000000 -0800
@@ -291,6 +291,16 @@
$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 @@
$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 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' ;
==== //depot/perl/t/op/sprintf2.t#14 (text) ====
Index: perl/t/op/sprintf2.t
--- perl/t/op/sprintf2.t#13~34781~ 2008-11-09 01:52:31.000000000 -0800
+++ perl/t/op/sprintf2.t 2008-11-09 05:42:58.000000000 -0800
@@ -161,10 +161,7 @@
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");
}
}
End of Patch.
