[Ada] Small improvement to System.Value_R.Scan_Raw_Real

gcc/ada/

	* libgnat/s-valuer.adb (Scan_Decimal_Digits): Round Extra.
	(Scan_Integral_Digits): Likewise.

1 files changed, 40 insertions, 6 deletions

diff --git a/gcc/ada/libgnat/s-valuer.adb b/gcc/ada/libgnat/s-valuer.adb
index 3fdf67f..0fa4fe1 100644
--- a/gcc/ada/libgnat/s-valuer.adb
+++ b/gcc/ada/libgnat/s-valuer.adb
@@ -144,6 +144,9 @@ package body System.Value_R is
       --  Set to True if addition of a digit will cause Value to be superior
       --  to Precision_Limit.
 
+      Precision_Limit_Just_Reached : Boolean := False;
+      --  Set to True if Precision_Limit_Reached was just set to True
+
       Digit : Char_As_Digit;
       --  The current digit
 
@@ -185,11 +188,24 @@ package body System.Value_R is
 
          --  If precision limit has been reached, just ignore any remaining
          --  digits for the computation of Value and Scale, but store the
-         --  first in Extra. The scanning should continue only to assess the
-         --  validity of the string.
+         --  first in Extra and use the second to round Extra. The scanning
+         --  should continue only to assess the validity of the string.
+
+         if Precision_Limit_Reached then
+            if Precision_Limit_Just_Reached then
+               if Digit >= Base / 2 then
+                  if Extra = Base - 1 then
+                     Extra := 0;
+                     Value := Value + 1;
+                  else
+                     Extra := Extra + 1;
+                  end if;
+               end if;
 
-         if not Precision_Limit_Reached then
+               Precision_Limit_Just_Reached := False;
+            end if;
 
+         else
             --  Trailing '0' digits are ignored until a non-zero digit is found
 
             if Digit = 0 then
@@ -218,7 +234,7 @@ package body System.Value_R is
                Temp := Value * Uns (Base) + Uns (Digit);
 
                if Value <= Umax
-                   or else (Value <= UmaxB and then Temp <= Precision_Limit)
+                 or else (Value <= UmaxB and then Temp <= Precision_Limit)
                then
                   Value := Temp;
                   Scale := Scale - 1;
@@ -226,6 +242,7 @@ package body System.Value_R is
                else
                   Extra := Digit;
                   Precision_Limit_Reached := True;
+                  Precision_Limit_Just_Reached := True;
                end if;
             end if;
          end if;
@@ -289,6 +306,9 @@ package body System.Value_R is
       --  Set to True if addition of a digit will cause Value to be superior
       --  to Precision_Limit.
 
+      Precision_Limit_Just_Reached : Boolean := False;
+      --  Set to True if Precision_Limit_Reached was just set to True
+
       Digit : Char_As_Digit;
       --  The current digit
 
@@ -324,12 +344,25 @@ package body System.Value_R is
 
          --  If precision limit has been reached, just ignore any remaining
          --  digits for the computation of Value, but update Scale and store
-         --  the first in Extra. The scanning should continue only to assess
-         --  the validity of the string.
+         --  the first in Extra and use the second to round Extra. The scanning
+         --  should continue only to assess the validity of the string.
 
          if Precision_Limit_Reached then
             Scale := Scale + 1;
 
+            if Precision_Limit_Just_Reached then
+               if Digit >= Base / 2 then
+                  if Extra = Base - 1 then
+                     Extra := 0;
+                     Value := Value + 1;
+                  else
+                     Extra := Extra + 1;
+                  end if;
+               end if;
+
+               Precision_Limit_Just_Reached := False;
+            end if;
+
          else
             Temp := Value * Uns (Base) + Uns (Digit);
 
@@ -341,6 +374,7 @@ package body System.Value_R is
             else
                Extra := Digit;
                Precision_Limit_Reached := True;
+               Precision_Limit_Just_Reached := True;
                Scale := Scale + 1;
             end if;
          end if;