In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/5208a0305e9e82c534fa034515d54a0409dfcc77?hp=0b1d8e2d68e53d65f46c0455f536bce7f0797bdd>
- Log ----------------------------------------------------------------- commit 5208a0305e9e82c534fa034515d54a0409dfcc77 Author: Jarkko Hietaniemi <[email protected]> Date: Thu Aug 11 19:53:30 2016 -0400 Fix on top of 75326c48. Worked partly accidentally, and as a bonus caused asan off-stack-variable read violations. M sv.c M t/op/sprintf2.t commit 749d85343f3cdb65891a5fe3b9f55ef3a5b03ca8 Author: Jarkko Hietaniemi <[email protected]> Date: Thu Aug 11 18:19:00 2016 -0400 The new tests are valid only for IEEE 754 64-bit doubles. The tests do not fail (I wish), they would just need to be different for example for the 80-bt x86 long doubles, for example, which scale differently: perl -wle 'printf "%a\n", -1.5' # IEEE 754 64-bit -0x1.8+0 perl -wle 'printf "%a\n", -1.5' # x86 80-bit -0xcp-3 In any system: perl -wle 'print -0x1.8p+0' -1.5 perl -wle 'print -0xcp-3' -1.5 See earlier in this file a long if-elsif chain when testing the @hexfloat because of this very same reason. M t/op/sprintf2.t ----------------------------------------------------------------------- Summary of changes: sv.c | 10 +++---- t/op/sprintf2.t | 92 ++++++++++++++++++++++++++++----------------------------- 2 files changed, 51 insertions(+), 51 deletions(-) diff --git a/sv.c b/sv.c index ce1a8ce..ae70d7b 100644 --- a/sv.c +++ b/sv.c @@ -12517,12 +12517,12 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p bool overflow = FALSE; if (v0[precis + 1] < 0x8) { /* Round down, nothing to do. */ - } else if (v[precis + 1] > 0x8) { + } else if (v0[precis + 1] > 0x8) { /* Round up. */ - v0[precis + 1]++; - overflow = v0[precis + 1] > 0xF; - v0[precis + 1] &= 0xF; - } else { /* v[precis + 1] == 0x8 */ + v0[precis]++; + overflow = v0[precis] > 0xF; + v0[precis] &= 0xF; + } else { /* v0[precis] == 0x8 */ /* Half-point: round towards the one * with the even least-significant digit: * 08 -> 0 88 -> 8 diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t index 3b8bb69..d281850 100644 --- a/t/op/sprintf2.t +++ b/t/op/sprintf2.t @@ -786,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.2p-1065' ], + [ '3e-321', '%.1a', '0x1.3p-1065' ], [ '3e-322', '%.1a', '0x1.ep-1069' ], [ '3e-323', '%.1a', '0x1.8p-1072' ], [ '3e-324', '%.1a', '0x1.0p-1074' ], @@ -794,55 +794,55 @@ SKIP: { # IEEE 754 64-bit skip("nv_preserves_uv_bits is $Config{nv_preserves_uv_bits}, not 53", - scalar @subnormals) + scalar @subnormals + 34) unless $Config{nv_preserves_uv_bits} == 53; for my $t (@subnormals) { my $s = sprintf($t->[1], $t->[0]); 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"); + # [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
