package warnings;
-our $VERSION = '1.25';
+our $VERSION = '1.26';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
|
+- redefine
|
+ +- redundant
+ |
+- regexp
|
+- severe --------+
'experimental::win32_perlio'=> 120,
'missing' => 122,
+ 'redundant' => 124,
);
our %Bits = (
- 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05", # [0..61]
+ 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..62]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [36]
'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
+ 'redundant' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [62]
'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [37]
'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [38]
);
our %DeadBits = (
- 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x0a", # [0..61]
+ 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..62]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [36]
'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
+ 'redundant' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [62]
'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [37]
'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [38]
$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
$DEFAULT = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x15\x01", # [2,56,52,53,57,54,58,55,60,4,22,23,25]
-$LAST_BIT = 124 ;
+$LAST_BIT = 126 ;
$BYTES = 16 ;
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
char ebuf[IV_DIG * 4 + NV_DIG + 32];
/* large enough for "%#.#f" --chip */
/* what about long double NVs? --jhi */
+ bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED;
(void)SvPV_force_nomg(sv, origlen);
/* special-case "", "%s", and "%-p" (SVf - see below) */
- if (patlen == 0)
+ if (patlen == 0) {
+ if (svmax && ckWARN(WARN_REDUNDANT))
+ Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
+ PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
return;
+ }
if (patlen == 2 && pat[0] == '%' && pat[1] == 's') {
+ if (svmax > 1 && ckWARN(WARN_REDUNDANT))
+ Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
+ PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
+
if (args) {
const char * const s = va_arg(*args, char*);
sv_catpv_nomg(sv, s ? s : nullstr);
}
if (args && patlen == 3 && pat[0] == '%' &&
pat[1] == '-' && pat[2] == 'p') {
+ if (svmax > 1 && ckWARN(WARN_REDUNDANT))
+ Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
+ PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
argsv = MUTABLE_SV(va_arg(*args, void*));
sv_catsv_nomg(sv, argsv);
return;
pp = pat + 2;
while (*pp >= '0' && *pp <= '9')
digits = 10 * digits + (*pp++ - '0');
+
+ /* XXX: Why do this `svix < svmax` test? Couldn't we just
+ format the first argument and WARN_REDUNDANT if svmax > 1?
+ Munged by Nicholas Clark in v5.13.0-209-g95ea86d */
if (pp - pat == (int)patlen - 1 && svix < svmax) {
const NV nv = SvNV(*svargs);
if (*pp == 'g') {
if (*q == '$') {
++q;
efix = width;
+ if (!no_redundant_warning)
+ /* I've forgotten if it's a better
+ micro-optimization to always set this or to
+ only set it if it's unset */
+ no_redundant_warning = TRUE;
} else {
goto gotwidth;
}
goto vector;
}
}
+
+ /* Now that we've consumed all our printf format arguments (svix)
+ * do we have things left on the stack that we didn't use?
+ */
+ if (!no_redundant_warning && svmax >= svix + 1 && ckWARN(WARN_REDUNDANT)) {
+ Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
+ PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
+ }
+
SvTAINT(sv);
RESTORE_LC_NUMERIC(); /* Done outside loop, so don't have to save/restore
$w .= ' UNINIT';
} elsif ($_[0] =~ /^Missing argument/) {
$w .= ' MISSING';
+ } elsif ($_[0] =~ /^Redundant argument/) {
+ $w .= ' REDUNDANT';
} elsif ($_[0]=~/^vector argument not supported with alpha versions/) {
$w .= ' ALPHA';
} else {
# template data result
__END__
->%6. 6s< >''< >%6. 6s INVALID< >(See use of $w in code above)<
->%6 .6s< >''< >%6 .6s INVALID<
->%6.6 s< >''< >%6.6 s INVALID<
->%A< >''< >%A INVALID<
+>%6. 6s< >''< >%6. 6s INVALID REDUNDANT< >(See use of $w in code above)<
+>%6 .6s< >''< >%6 .6s INVALID REDUNDANT<
+>%6.6 s< >''< >%6.6 s INVALID REDUNDANT<
+>%A< >''< >%A INVALID REDUNDANT<
>%B< >2**32-1< >11111111111111111111111111111111<
>%+B< >2**32-1< >11111111111111111111111111111111<
>%#B< >2**32-1< >0B11111111111111111111111111111111<
->%C< >''< >%C INVALID<
+>%C< >''< >%C INVALID REDUNDANT<
>%D< >0x7fffffff< >2147483647< >Synonym for %ld<
>%E< >123456.789< >1.234568E+05< >Like %e, but using upper-case "E"<
>%F< >123456.789< >123456.789000< >Synonym for %f<
>%G< >12345.6789< >12345.7<
>%G< >1234567e96< >1.23457E+102< >exponent too big skip: os390<
>%G< >.1234567e-101< >1.23457E-102< >exponent too small skip: os390<
->%H< >''< >%H INVALID<
->%I< >''< >%I INVALID<
->%J< >''< >%J INVALID<
->%K< >''< >%K INVALID<
->%L< >''< >%L INVALID<
->%M< >''< >%M INVALID<
->%N< >''< >%N INVALID<
+>%H< >''< >%H INVALID REDUNDANT<
+>%I< >''< >%I INVALID REDUNDANT<
+>%J< >''< >%J INVALID REDUNDANT<
+>%K< >''< >%K INVALID REDUNDANT<
+>%L< >''< >%L INVALID REDUNDANT<
+>%M< >''< >%M INVALID REDUNDANT<
+>%N< >''< >%N INVALID REDUNDANT<
>%O< >2**32-1< >37777777777< >Synonym for %lo<
->%P< >''< >%P INVALID<
->%Q< >''< >%Q INVALID<
->%R< >''< >%R INVALID<
->%S< >''< >%S INVALID<
->%T< >''< >%T INVALID<
+>%P< >''< >%P INVALID REDUNDANT<
+>%Q< >''< >%Q INVALID REDUNDANT<
+>%R< >''< >%R INVALID REDUNDANT<
+>%S< >''< >%S INVALID REDUNDANT<
+>%T< >''< >%T INVALID REDUNDANT<
>%U< >2**32-1< >4294967295< >Synonym for %lu<
->%V< >''< >%V INVALID<
->%W< >''< >%W INVALID<
+>%V< >''< >%V INVALID REDUNDANT<
+>%W< >''< >%W INVALID REDUNDANT<
>%X< >2**32-1< >FFFFFFFF< >Like %x, but with u/c letters<
>%#X< >2**32-1< >0XFFFFFFFF<
->%Y< >''< >%Y INVALID<
->%Z< >''< >%Z INVALID<
->%a< >''< >%a INVALID<
+>%Y< >''< >%Y INVALID REDUNDANT<
+>%Z< >''< >%Z INVALID REDUNDANT<
+>%a< >''< >%a INVALID REDUNDANT<
>%b< >2**32-1< >11111111111111111111111111111111<
>%+b< >2**32-1< >11111111111111111111111111111111<
>%#b< >2**32-1< >0b11111111111111111111111111111111<
>%.0f< >1< >1<
>%#.0f< >1< >1.<
>%.0lf< >1< >1< >'l' should have no effect<
->%.0hf< >1< >%.0hf INVALID< >'h' should be rejected<
+>%.0hf< >1< >%.0hf INVALID REDUNDANT< >'h' should be rejected<
>%g< >12345.6789< >12345.7<
>%+g< >12345.6789< >+12345.7<
>%#g< >12345.6789< >12345.7<
>%-13g< >1234567.89< >1.23457e+06 <
>%g< >.1234567E-101< >1.23457e-102< >exponent too small skip: os390<
>%g< >1234567E96< >1.23457e+102< >exponent too big skip: os390<
->%h< >''< >%h INVALID<
+>%h< >''< >%h INVALID REDUNDANT<
>%i< >123456.789< >123456< >Synonym for %d<
->%j< >''< >%j INVALID<
->%k< >''< >%k INVALID<
->%l< >''< >%l INVALID<
->%m< >''< >%m INVALID<
+>%j< >''< >%j INVALID REDUNDANT<
+>%k< >''< >%k INVALID REDUNDANT<
+>%l< >''< >%l INVALID REDUNDANT<
+>%m< >''< >%m INVALID REDUNDANT<
>%s< >sprintf('%%n%n %d', $n, $n)< >%n 2< >Slight sneakiness to test %n<
>%s< >$n="abc"; sprintf(' %n%s', substr($n,1,1), $n)< > a1c< >%n w/magic<
>%s< >no warnings; sprintf('%s%n', chr(256)x5, $n),$n< >5< >Unicode %n<
>%#06.4o< >18< > 0022< >0 flag with precision: no effect<
>%d< >$p=sprintf('%p',$p);$p=~/^[0-9a-f]+$/< >1< >Coarse hack: hex from %p?<
>%d< >$p=sprintf('%-8p',$p);$p=~/^[0-9a-f]+\s*$/< >1< >Coarse hack: hex from %p?<
->%#p< >''< >%#p INVALID<
->%q< >''< >%q INVALID<
->%r< >''< >%r INVALID<
+>%#p< >''< >%#p INVALID REDUNDANT<
+>%q< >''< >%q INVALID REDUNDANT<
+>%r< >''< >%r INVALID REDUNDANT<
>%s< >[]< > MISSING<
> %s< >[]< > MISSING<
>%s< >'string'< >string<
>%3.*s< >[1, 'string']< > s<
>%3.*s< >[0, 'string']< > <
>%3.*s< >[-1,'string']< >string< >negative precision to be ignored<
->%t< >''< >%t INVALID<
+>%t< >''< >%t INVALID REDUNDANT<
>%u< >2**32-1< >4294967295<
>%+u< >2**32-1< >4294967295<
>%#u< >2**32-1< >4294967295<
>% 4.3u< >18< > 018<
>%04.3u< >18< > 018< >0 flag with precision: no effect<
>%.3u< >18< >018<
->%v< >''< >%v INVALID<
->%w< >''< >%w INVALID<
+>%v< >''< >%v INVALID REDUNDANT<
+>%w< >''< >%w INVALID REDUNDANT<
>%x< >2**32-1< >ffffffff<
>%+x< >2**32-1< >ffffffff<
>%#x< >2**32-1< >0xffffffff<
>%#+.*x< >[-1,0]< >0<
>%# .*x< >[-1,0]< >0<
>%#0.*x< >[-1,0]< >0<
->%y< >''< >%y INVALID<
->%z< >''< >%z INVALID<
+>%y< >''< >%y INVALID REDUNDANT<
+>%z< >''< >%z INVALID REDUNDANT<
>%2$d %1$d< >[12, 34]< >34 12<
->%*2$d< >[12, 3]< > 12<
+>%*2$d< >[12, 3]< > 12 REDUNDANT<
>%2$d %d< >[12, 34]< >34 12<
>%2$d %d %d< >[12, 34]< >34 12 34<
>%3$d %d %d< >[12, 34, 56]< >56 12 34<
>%2$*3$d %d< >[12, 34, 3]< > 34 12<
->%*3$2$d %d< >[12, 34, 3]< >%*3$2$d 12 INVALID<
+>%*3$2$d %d< >[12, 34, 3]< >%*3$2$d 12 INVALID REDUNDANT<
>%2$d< >12< >0 MISSING<
->%0$d< >12< >%0$d INVALID<
+>%0$d< >12< >%0$d INVALID REDUNDANT<
>%1$$d< >12< >%1$$d INVALID<
>%1$1$d< >12< >%1$1$d INVALID<
->%*2$*2$d< >[12, 3]< >%*2$*2$d INVALID<
->%*2*2$d< >[12, 3]< >%*2*2$d INVALID<
->%*2$1d< >[12, 3]< >%*2$1d INVALID<
+>%*2$*2$d< >[12, 3]< >%*2$*2$d INVALID REDUNDANT<
+>%*2*2$d< >[12, 3]< >%*2*2$d INVALID REDUNDANT<
+>%*2$1d< >[12, 3]< >%*2$1d INVALID REDUNDANT<
>%0v2.2d< >''< ><
->%vc,%d< >[63, 64, 65]< >%vc,63 INVALID<
->%v%,%d< >[63, 64, 65]< >%v%,63 INVALID<
->%vd,%d< >["\x1", 2, 3]< >1,2<
->%vf,%d< >[1, 2, 3]< >%vf,1 INVALID<
->%vF,%d< >[1, 2, 3]< >%vF,1 INVALID<
->%ve,%d< >[1, 2, 3]< >%ve,1 INVALID<
->%vE,%d< >[1, 2, 3]< >%vE,1 INVALID<
->%vg,%d< >[1, 2, 3]< >%vg,1 INVALID<
->%vG,%d< >[1, 2, 3]< >%vG,1 INVALID<
->%vp< >''< >%vp INVALID<
->%vn< >''< >%vn INVALID<
->%vs,%d< >[1, 2, 3]< >%vs,1 INVALID<
->%v_< >''< >%v_ INVALID<
->%v#x< >''< >%v#x INVALID<
+>%vc,%d< >[63, 64, 65]< >%vc,63 INVALID REDUNDANT<
+>%v%,%d< >[63, 64, 65]< >%v%,63 INVALID REDUNDANT<
+>%vd,%d< >["\x1", 2, 3]< >1,2 REDUNDANT<
+>%vf,%d< >[1, 2, 3]< >%vf,1 INVALID REDUNDANT<
+>%vF,%d< >[1, 2, 3]< >%vF,1 INVALID REDUNDANT<
+>%ve,%d< >[1, 2, 3]< >%ve,1 INVALID REDUNDANT<
+>%vE,%d< >[1, 2, 3]< >%vE,1 INVALID REDUNDANT<
+>%vg,%d< >[1, 2, 3]< >%vg,1 INVALID REDUNDANT<
+>%vG,%d< >[1, 2, 3]< >%vG,1 INVALID REDUNDANT<
+>%vp< >''< >%vp INVALID REDUNDANT<
+>%vn< >''< >%vn INVALID REDUNDANT<
+>%vs,%d< >[1, 2, 3]< >%vs,1 INVALID REDUNDANT<
+>%v_< >''< >%v_ INVALID REDUNDANT<
+>%v#x< >''< >%v#x INVALID REDUNDANT<
>%v02x< >"\x66\x6f\x6f\012"< >66.6f.6f.0a<
>%#v.8b< >"\141\000\142"< >0b01100001.00000000.0b01100010< >perl #39530<
>%#v.0o< >"\001\000\002\000"< >01.0.02.0<
>%#v.2X< >"\141\x{1e01}\017\142\x{1e03}"< >0X61.0X1E01.0X0F.0X62.0X1E03< >perl #39530<
>%V-%s< >["Hello"]< >%V-Hello INVALID<
>%K %d %d< >[13, 29]< >%K 13 29 INVALID<
->%*.*K %d< >[13, 29, 76]< >%*.*K 13 INVALID<
+>%*.*K %d< >[13, 29, 76]< >%*.*K 13 INVALID REDUNDANT<
>%4$K %d< >[45, 67]< >%4$K 45 MISSING INVALID<
>%d %K %d< >[23, 45]< >23 %K 45 INVALID<
->%*v*999\$d %d %d< >[11, 22, 33]< >%*v*999\$d 11 22 INVALID<
+>%*v*999\$d %d %d< >[11, 22, 33]< >%*v*999\$d 11 22 INVALID REDUNDANT<
>%#b< >0< >0<
>%#o< >0< >0<
>%#x< >0< >0<
require './test.pl';
}
-plan tests => 1370;
+plan tests => 1406;
use strict;
use Config;
is($bad, 0, "unexpected warnings");
}
+# Tests for "missing argument" and "redundant argument" warnings
+{
+ my ($warn_missing, $warn_redundant, $warn_bad) = (0,0,0);
+ local $SIG{__WARN__} = sub {
+ if ($_[0] =~ /missing argument/i) {
+ $warn_missing++
+ }
+ elsif ($_[0] =~ /redundant argument/i) {
+ $warn_redundant++
+ }
+ else {
+ $warn_bad++
+ }
+ };
+
+ my @tests = (
+ # The "", "%s", and "%-p" formats have special-case handling
+ # in sv.c
+ {
+ fmt => "",
+ args => [ qw( x ) ],
+ res => "",
+ m => 0,
+ r => 1,
+ },
+ {
+ fmt => "%s",
+ args => [ qw( x y ) ],
+ res => "x",
+ m => 0,
+ r => 1,
+ },
+ {
+ fmt => "%-p",
+ args => [ qw( x y ) ],
+ res => qr/^[0-9a-f]+$/as,
+ m => 0,
+ r => 1,
+ },
+ # Other non-specialcased patterns
+ {
+ fmt => "%s : %s",
+ args => [ qw( a b c ) ],
+ res => "a : b",
+ m => 0,
+ r => 1,
+ },
+ {
+ fmt => "%s : %s : %s",
+ args => [ qw( a b c d e ) ],
+ res => "a : b : c",
+ m => 0,
+ # Note how we'll only warn about redundant arguments once,
+ # even though both "d" and "e" are redundant...
+ r => 1,
+ },
+ {
+ fmt => "%s : %s : %s",
+ args => [ ],
+ res => " : : ",
+ # ...But when arguments are missing we'll warn about every
+ # missing argument. This difference between the two
+ # warnings is a feature.
+ m => 3,
+ r => 0,
+ },
+
+ # Tests for format parameter indexes.
+ #
+ # Deciding what to do about these is a bit tricky, and so is
+ # "correctly" warning about missing arguments on them.
+ #
+ # Should we warn if you supply 4 arguments but only use
+ # argument 1,3 & 4? Or only if you supply 5 arguments and your
+ # highest used argument is 4?
+ #
+ # For some uses of this printf feature (e.g. i18n systems)
+ # it's a always a logic error to not print out every provided
+ # argument, but for some other uses skipping some might be a
+ # feature (although you could argue that then printf should be
+ # called as e.g:
+ #
+ # printf q[%1$s %3$s], x(), undef, z();
+ #
+ # Instead of:
+ #
+ # printf q[%1$s %3$s], x(), y(), z();
+ #
+ # Since calling the (possibly expensive) y() function is
+ # completely redundant there.
+ #
+ # We deal with all these potential problems by not even
+ # trying. If the pattern contains any format parameter indexes
+ # whatsoever we'll never warn about redundant arguments.
+ {
+ fmt => '%1$s : %2$s',
+ args => [ qw( x y z ) ],
+ res => "x : y",
+ m => 0,
+ r => 0,
+ },
+ {
+ fmt => '%2$s : %4$s : %5$s',
+ args => [ qw( a b c d )],
+ res => "b : d : ",
+ m => 1,
+ r => 0,
+ },
+ {
+ fmt => '%s : %1$s : %s',
+ args => [ qw( x y z ) ],
+ res => "x : x : y",
+ m => 0,
+ r => 0,
+ },
+
+ );
+
+ for my $i (0..$#tests) {
+ my $test = $tests[$i];
+ my $result = sprintf $test->{fmt}, @{$test->{args}};
+
+ my $prefix = "For format '$test->{fmt}' and arguments/result '@{$test->{args}}'/'$result'";
+ if (ref $test->{res} eq 'Regexp') {
+ like($result, $test->{res}, "$prefix got the right result");
+ } else {
+ is($result, $test->{res}, "$prefix got the right result");
+ }
+ is($warn_missing, $test->{m}, "$prefix got '$test->{m}' 'missing argument' warnings");
+ is($warn_redundant, $test->{r}, "$prefix got '$test->{r}' 'redundant argument' warnings");
+ is($warn_bad, 0, "$prefix No unknown warnings");
+
+ ($warn_missing, $warn_redundant, $warn_bad) = (0,0,0);
+ }
+}
+
{
foreach my $ord (0 .. 255) {
my $bad = 0;