Skip to content

Commit

Permalink
sprintf: handle sized int-ish formats with Inf/Nan
Browse files Browse the repository at this point in the history
The code path taken when int-ish formats saw an Inf/Nan was to jump to the
floating-point handler, but then that would warn about (valid) size
qualifiers. For example before:

    $ perl -we'printf "[%hi]\n", Inf'
    Invalid conversion in printf: "%hi" at -e line 1.
    Redundant argument in printf at -e line 1.
    [%hi]
    $

After this commit:

    $ perl -we'printf "[%hi]\n", Inf'
    [Inf]
    $

It also makes the code simpler.
  • Loading branch information
iabyn committed Jun 7, 2017
1 parent 5a5fe90 commit 559a021
Show file tree
Hide file tree
Showing 2 changed files with 49 additions and 20 deletions.
35 changes: 15 additions & 20 deletions sv.c
Expand Up @@ -11639,7 +11639,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
I32 epix = 0; /* explicit precision index */
I32 evix = 0; /* explicit vector index */
bool asterisk = FALSE;
bool infnan = FALSE;

/* echo everything up to the next format specification */
for (q = p; q < patend && *q != '%'; ++q) ;
Expand Down Expand Up @@ -12014,25 +12013,24 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
}
}

if (argsv && strchr("BbcDdiOopuUXx",*q)) {
c = *q++; /* c now holds the conversion type */

if (argsv && strchr("BbcDdiOopuUXx", c)) {
/* XXX va_arg(*args) case? need peek, use va_copy? */
SvGETMAGIC(argsv);
if (UNLIKELY(SvAMAGIC(argsv)))
argsv = sv_2num(argsv);
infnan = UNLIKELY(isinfnansv(argsv));
if (UNLIKELY(isinfnansv(argsv)))
goto handle_infnan_argsv;
}

switch (c = *q++) {
switch (c) {

/* STRINGS */

case 'c':
if (vectorize)
goto unknown;
if (infnan)
Perl_croak(aTHX_ "Cannot printf %" NVgf " with '%c'",
/* no va_arg() case */
SvNV_nomg(argsv), (int)c);
uv = (args) ? va_arg(*args, int) : SvIV_nomg(argsv);
if ((uv > 255 ||
(!UVCHR_IS_INVARIANT(uv) && SvUTF8(sv)))
Expand Down Expand Up @@ -12089,9 +12087,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
/* INTEGERS */

case 'p':
if (infnan) {
goto floating_point;
}
if (alt || vectorize)
goto unknown;
uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
Expand All @@ -12107,9 +12102,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
/* FALLTHROUGH */
case 'd':
case 'i':
if (infnan) {
goto floating_point;
}
if (vectorize) {
STRLEN ulen;
if (!veclen)
Expand Down Expand Up @@ -12211,9 +12203,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
base = 16;

uns_integer:
if (infnan) {
goto floating_point;
}
if (vectorize) {
STRLEN ulen;
vector:
Expand Down Expand Up @@ -12330,8 +12319,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p

/* FLOATING POINT */

floating_point:

case 'F':
c = 'f'; /* maybe %F isn't supported here */
/* FALLTHROUGH */
Expand Down Expand Up @@ -12406,12 +12393,20 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
}
else
{
if (!infnan) SvGETMAGIC(argsv);
SvGETMAGIC(argsv);
/* we jump here if an int-ish format encountered an
* infinite/Nan argsv. After setting nv/fv, it falls
* into the isinfnan block which follows */
handle_infnan_argsv:
nv = SvNV_nomg(argsv);
NV_TO_FV(nv, fv);
}

if (Perl_isinfnan(nv)) {
if (c == 'c')
Perl_croak(aTHX_ "Cannot printf %" NVgf " with '%c'",
SvNV_nomg(argsv), (int)c);

elen = S_infnan_2pv(nv, ebuf, sizeof(ebuf), plus);
assert(elen);
eptr = ebuf;
Expand Down
34 changes: 34 additions & 0 deletions t/op/infnan.t
Expand Up @@ -528,4 +528,38 @@ cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg");
}
}

# Size qualifiers shouldn't affect printing Inf/Nan
#
# Prior to the commit which introduced these tests and the fix,
# the code path taken when int-ish formats saw an Inf/Nan was to
# jump to the floating-point handler, but then that would
# warn about (valid) qualifiers.

{
my @w;
local $SIG{__WARN__} = sub { push @w, $_[0] };

for my $format (qw(B b c D d i O o p U u X x)) {
# skip unportable: j
for my $size (qw(hh h l q L ll t z)) {
for my $num ($NInf, $PInf, $NaN) {
@w = ();
my $res = eval { sprintf "%${size}${format}", $num; };
my $desc = "sprintf(\"%${size}${format}\", $num)";
if ($format eq 'c') {
like($@, qr/Cannot printf $num with 'c'/, "$desc: like");
}
else {
is($res, $num, "$desc: equality");
}

is (@w, 0, "$desc: warnings")
or do {
diag("got warning: [$_]") for map { chomp; $_} @w;
};
}
}
}
}

done_testing();

0 comments on commit 559a021

Please sign in to comment.