In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/be93048a43d87d317acca5b37619111b6a5f8c44?hp=9a2fefd6ac80d3f6deaec2c6314b286ac7bb8e7e>
- Log ----------------------------------------------------------------- commit be93048a43d87d317acca5b37619111b6a5f8c44 Author: Jarkko Hietaniemi <[email protected]> Date: Thu Aug 11 09:18:27 2016 -0400 [rt.perl.org #128893]: printf %a botches 0 flag for negative values M sv.c M t/op/sprintf2.t commit 75326c485e9d40be5c22d508f581cdea68b244ce Author: Jarkko Hietaniemi <[email protected]> Date: Thu Aug 11 09:15:21 2016 -0400 [rt.perl.org #128890]: printf %a rounds incorrectly M sv.c M t/op/sprintf2.t commit a9ce335538454d590920dab8d62db84948f1fb83 Author: Jarkko Hietaniemi <[email protected]> Date: Thu Aug 11 09:12:04 2016 -0400 [rt.perl.org #128889]: printf %a mishandles negative pseudo-precision (the fix for [rt.perl.org #128888] fixed also this one) M t/op/sprintf2.t commit 82229f9f47d9a169b59715582fb5a09b5a4ac0ff Author: Jarkko Hietaniemi <[email protected]> Date: Wed Aug 10 19:06:03 2016 -0400 [rt.perl.org #128888]: printf %a mishandles zero precision M sv.c M t/op/sprintf2.t commit 520f3e58c346a7bc3ef0509dfe0db206dae454ee Author: Jarkko Hietaniemi <[email protected]> Date: Wed Aug 10 19:47:19 2016 -0400 Comment fix for b6d9b423 M sv.c commit 94d00769fba240ffb86f18b3d66341fb1d24ae6c Author: Jarkko Hietaniemi <[email protected]> Date: Wed Aug 10 19:13:36 2016 -0400 Add rt.perl.org reference for b6d9b423 M t/op/sprintf2.t ----------------------------------------------------------------------- Summary of changes: sv.c | 91 ++++++++++++++++++++++++++++++++++----------------------- t/op/sprintf2.t | 49 +++++++++++++++++++++++++++++-- 2 files changed, 101 insertions(+), 39 deletions(-) diff --git a/sv.c b/sv.c index fab6e5e..ce1a8ce 100644 --- a/sv.c +++ b/sv.c @@ -12421,13 +12421,14 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p int exponent = 0; /* exponent of the floating point input */ bool hexradix = FALSE; /* should we output the radix */ bool subnormal = FALSE; /* IEEE 754 subnormal/denormal */ + bool negative = FALSE; - /* XXX: denormals, NaN, Inf. + /* XXX: NaN, Inf -- though they are printed as "NaN" and "Inf". * * For example with denormals, (assuming the vanilla * 64-bit double): the exponent is zero. 1xp-1074 is * the smallest denormal and the smallest double, it - * should be output as 0x0.0000000000001p-1022 to + * could be output also as 0x0.0000000000001p-1022 to * match its internal structure. */ vend = S_hextract(aTHX_ nv, &exponent, &subnormal, vhex, NULL); @@ -12448,9 +12449,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p # endif #endif - if (fv < 0 - || Perl_signbit(nv) - ) + negative = fv < 0 || Perl_signbit(nv); + if (negative) *p++ = '-'; else if (plus) *p++ = plus; @@ -12510,43 +12510,54 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p v0 = vhex; } - if (precis > 0) { + if (has_precis) { U8* ve = (subnormal ? vlnz + 1 : vend); SSize_t vn = ve - (subnormal ? vfnz : vhex); if ((SSize_t)(precis + 1) < vn) { - bool round; - - v = v0 + precis + 1; - /* Round away from zero: if the tail - * beyond the precis xdigits is equal to - * or greater than 0x8000... */ - round = *v > 0x8; - if (!round && *v == 0x8) { - for (v++; v < ve; v++) { - if (*v) { - round = TRUE; - break; - } + bool overflow = FALSE; + if (v0[precis + 1] < 0x8) { + /* Round down, nothing to do. */ + } else if (v[precis + 1] > 0x8) { + /* Round up. */ + v0[precis + 1]++; + overflow = v0[precis + 1] > 0xF; + v0[precis + 1] &= 0xF; + } else { /* v[precis + 1] == 0x8 */ + /* Half-point: round towards the one + * with the even least-significant digit: + * 08 -> 0 88 -> 8 + * 18 -> 2 98 -> a + * 28 -> 2 a8 -> a + * 38 -> 4 b8 -> c + * 48 -> 4 c8 -> c + * 58 -> 6 d8 -> e + * 68 -> 6 e8 -> e + * 78 -> 8 f8 -> 10 */ + if ((v0[precis] & 0x1)) { + v0[precis]++; } + overflow = v0[precis] > 0xF; + v0[precis] &= 0xF; } - if (round) { - for (v = v0 + precis; v >= v0; v--) { - if (*v < 0xF) { - (*v)++; + + if (overflow) { + for (v = v0 + precis - 1; v >= v0; v--) { + (*v)++; + overflow = *v > 0xF; + (*v) &= 0xF; + if (!overflow) { break; } - *v = 0; - if (v == v0) { - /* If the carry goes all the way to - * the front, we need to output - * a single '1'. This goes against - * the "xdigit and then radix" - * but since this is "cannot happen" - * category, that is probably good. */ - *p++ = xdig[1]; - } + } + if (v == v0 && overflow) { + /* If the overflow goes all the + * way to the front, we need to + * insert 0x1 in front. */ + Move(v0, v0 + 1, vn, char); + *v0 = 0x1; } } + /* The new effective "last non zero". */ vlnz = v0 + precis; } @@ -12617,12 +12628,18 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p memset(PL_efloatbuf + elen, ' ', width - elen); } else if (fill == '0') { - /* Insert the zeros between the "0x" and - * the digits, otherwise we end up with - * "0000xHHH..." */ + /* Insert the zeros after the "0x" and the + * the potential sign, but before the digits, + * otherwise we end up with "0000xH.HHH...", + * when we want "0x000H.HHH..." */ STRLEN nzero = width - elen; char* zerox = PL_efloatbuf + 2; - Move(zerox, zerox + nzero, elen - 2, char); + STRLEN nmove = elen - 2; + if (negative || plus) { + zerox++; + nmove--; + } + Move(zerox, zerox + nzero, nmove, char); memset(zerox, fill, nzero); } else { diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t index b16482d..3b8bb69 100644 --- a/t/op/sprintf2.t +++ b/t/op/sprintf2.t @@ -262,7 +262,7 @@ if ($Config{nvsize} == 8 && print "# no hexfloat tests\n"; } -plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 37; +plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 71; use strict; use Config; @@ -761,6 +761,7 @@ SKIP: { } } +# [rt.perl.org #128843] SKIP: { my @subnormals = ( # Keep these as strings so that non-IEEE-754 don't trip over them. @@ -785,7 +786,7 @@ SKIP: { [ '3e-323', '%.4a', '0x1.8000p-1072' ], [ '3e-324', '%.4a', '0x1.0000p-1074' ], [ '3e-320', '%.1a', '0x1.8p-1062' ], - [ '3e-321', '%.1a', '0x1.3p-1065' ], + [ '3e-321', '%.1a', '0x1.2p-1065' ], [ '3e-322', '%.1a', '0x1.ep-1069' ], [ '3e-323', '%.1a', '0x1.8p-1072' ], [ '3e-324', '%.1a', '0x1.0p-1074' ], @@ -801,3 +802,47 @@ SKIP: { is($s, $t->[2], "subnormal @$t got $s"); } } + +# [rt.perl.org #128888] +is(sprintf("%a", 1.03125), "0x1.08p+0"); +is(sprintf("%.1a", 1.03125), "0x1.0p+0"); +is(sprintf("%.0a", 1.03125), "0x1p+0", "[rt.perl.org #128888]"); + +# [rt.perl.org #128889] +is(sprintf("%.*a", -1, 1.03125), "0x1.08p+0", "[rt.perl.org #128889]"); + +# [rt.perl.org #128890] +is(sprintf("%a", 0x1.18p+0), "0x1.18p+0"); +is(sprintf("%.1a", 0x1.08p+0), "0x1.0p+0"); +is(sprintf("%.1a", 0x1.18p+0), "0x1.2p+0", "[rt.perl.org #128890]"); +is(sprintf("%.1a", 0x1.28p+0), "0x1.2p+0"); +is(sprintf("%.1a", 0x1.38p+0), "0x1.4p+0"); +is(sprintf("%.1a", 0x1.48p+0), "0x1.4p+0"); +is(sprintf("%.1a", 0x1.58p+0), "0x1.6p+0"); +is(sprintf("%.1a", 0x1.68p+0), "0x1.6p+0"); +is(sprintf("%.1a", 0x1.78p+0), "0x1.8p+0"); +is(sprintf("%.1a", 0x1.88p+0), "0x1.8p+0"); +is(sprintf("%.1a", 0x1.98p+0), "0x1.ap+0"); +is(sprintf("%.1a", 0x1.a8p+0), "0x1.ap+0"); +is(sprintf("%.1a", 0x1.b8p+0), "0x1.cp+0"); +is(sprintf("%.1a", 0x1.c8p+0), "0x1.cp+0"); +is(sprintf("%.1a", 0x1.d8p+0), "0x1.ep+0"); +is(sprintf("%.1a", 0x1.e8p+0), "0x1.ep+0"); +is(sprintf("%.1a", 0x1.f8p+0), "0x2.0p+0"); + +is(sprintf("%.1a", 0x1.10p+0), "0x1.1p+0"); +is(sprintf("%.1a", 0x1.17p+0), "0x1.1p+0"); +is(sprintf("%.1a", 0x1.19p+0), "0x1.2p+0"); +is(sprintf("%.1a", 0x1.1fp+0), "0x1.2p+0"); + +is(sprintf("%.2a", 0x1.fffp+0), "0x2.00p+0"); +is(sprintf("%.2a", 0xf.fffp+0), "0x2.00p+3"); + +# [rt.perl.org #128893] +is(sprintf("%020a", 1.5), "0x0000000000001.8p+0"); +is(sprintf("%020a", -1.5), "-0x000000000001.8p+0", "[rt.perl.org #128893]"); +is(sprintf("%+020a", 1.5), "+0x000000000001.8p+0", "[rt.perl.org #128893]"); +is(sprintf("% 020a", 1.5), " 0x000000000001.8p+0", "[rt.perl.org #128893]"); +is(sprintf("%20a", -1.5), " -0x1.8p+0"); +is(sprintf("%+20a", 1.5), " +0x1.8p+0"); +is(sprintf("% 20a", 1.5), " 0x1.8p+0"); -- Perl5 Master Repository
