[perl #120426] atof() small value rounding errors

For something like 0.153e-305, which is small, but not quite the smallest
number (which is around 2.2e-308), adding extra digits to the fractional part
could cause unnecessary rounding to zero.

From the bug report:

    $ echo 0.1530e-305 | perl -e '$v = <STDIN>; print "v=", $v + 0, "\n";'
    v=0
    $ echo 0.153e-305  | perl -e '$v = <STDIN>; print "v=", $v + 0, "\n";'
    v=1.53e-306

This was because 0.1234e-305 is calculated as

    1234 / (10^309)

and 10^309 becomes infinity. In these edge cases, repeatedly decrement
the exponent and divide the mantissa by 10 until the exponent becomes in
range; in this case we instead calculate

    123 / (10^308)

2 files changed, 24 insertions, 1 deletions

diff --git a/numeric.c b/numeric.c
index c1bd581e32..756a86a08d 100644
--- a/numeric.c
+++ b/numeric.c
@@ -823,6 +823,17 @@ S_mulexp10(NV value, I32 exponent)
     if (exponent < 0) {
 	negative = 1;
 	exponent = -exponent;
+#ifdef NV_MAX_10_EXP
+        /* for something like 1234 x 10^-309, the action of calculating
+         * the intermediate value 10^309 then returning 1234 / (10^309)
+         * will fail, since 10^309 becomes infinity. In this case try to
+         * refactor it as 123 / (10^308) etc.
+         */
+        while (value && exponent > NV_MAX_10_EXP) {
+            exponent--;
+            value /= 10;
+        }
+#endif
     }
     for (bit = 1; exponent; bit <<= 1) {
 	if (exponent & bit) {
diff --git a/t/opbasic/arith.t b/t/opbasic/arith.t
index d85a9ba214..a90e84c071 100644
--- a/t/opbasic/arith.t
+++ b/t/opbasic/arith.t
@@ -9,7 +9,7 @@ BEGIN {
 # functions imported from t/test.pl or Test::More, as those programs/libraries
 # use operators which are what is being tested in this file.
 
-print "1..167\n";
+print "1..175\n";
 
 sub try ($$$) {
    print +($_[1] ? "ok" : "not ok"), " $_[0] - $_[2]\n";
@@ -456,3 +456,15 @@ else {
   print "ok ", $T++, " - infinity\n";
 }
 
+
+# [perl #120426]
+# small numbers shouldn't round to zero if they have extra floating digits
+
+try $T++,  0.153e-305 != 0.0,              '0.153e-305';
+try $T++,  0.1530e-305 != 0.0,             '0.1530e-305';
+try $T++,  0.15300e-305 != 0.0,            '0.15300e-305';
+try $T++,  0.153000e-305 != 0.0,           '0.153000e-305';
+try $T++,  0.1530000e-305 != 0.0,          '0.1530000e-305';
+try $T++,  0.1530001e-305 != 0.0,          '0.1530001e-305';
+try $T++,  1.17549435100e-38 != 0.0,       'min single';
+try $T++,  2.2250738585072014e-308 != 0.0, 'min double';