ada: Fix couple of issues in System.Value_D.Integer_To_Decimal function

The first issue is that the function would wrongly raise Constraint_Error
on the edge case where Val = 2**(Int'Size - 1) and Minus is not set.

The second issue is that the function takes a long time to deal with huge
negative exponents.

The change also contains minor consistency fixes for its counterpart that
is present in System.Value_F, namely Integer_To_Fixed.

gcc/ada/ChangeLog:

	* libgnat/s-valued.adb (Integer_To_Decimal): Deal specifically with
	Val = 2**(Int'Size - 1) if Minus is not set.  Exit the loops when V
	saturates to 0 in the case of (huge) negative exponents.  Use Base
	instead of B consistently in unsigned computations.
	* libgnat/s-valuef.adb (Integer_To_Fixed): Use Base instead of B
	consistently in unsigned computations.

diff --git a/gcc/ada/libgnat/s-valued.adb b/gcc/ada/libgnat/s-valued.adb
index 57d5c04ab105aa4ad52b011c412d4431dc3e72d1..4f2e102046688945a84a94d456716abd99d91e21 100644 (file)
--- a/gcc/ada/libgnat/s-valued.adb
+++ b/gcc/ada/libgnat/s-valued.adb
@@ -131,27 +131,39 @@ package body System.Value_D is
 
       --  Local variables
 
-      E : Uns := Uns (Extra2 / Base);
+      V : Uns      := Val;
+      S : Integer  := ScaleB;
+      E : Unsigned := Extra2 / Base;
 
    begin
+      --  The implementation of Value_R uses fully symmetric arithmetics
+      --  but here we cannot handle 2**(Int'Size - 1) if Minus is not set.
+
+      if V = 2**(Int'Size - 1) and then not Minus then
+         E := Unsigned (V rem Uns (Base));
+         V := V / Uns (Base);
+         S := S + 1;
+      end if;
+
       --  If the base of the value is 10 or its scaling factor is zero, then
       --  add the scales (they are defined in the opposite sense) and apply
       --  the result to the value, checking for overflow in the process.
 
-      if Base = 10 or else ScaleB = 0 then
-         declare
-            S : Integer := ScaleB + Scale;
-            V : Uns     := Val;
-
+      if Base = 10 or else S = 0 then
          begin
+            S := S + Scale;
+
             while S < 0 loop
+               if V = 0 then
+                  exit;
+               end if;
                V := V / 10;
                S := S + 1;
             end loop;
 
             while S > 0 loop
-               if V <= (Uns'Last - E) / 10 then
-                  V := V * 10 + E;
+               if V <= (Uns'Last - Uns (E)) / 10 then
+                  V := V * 10 + Uns (E);
                   S := S - 1;
                   E := 0;
                else
@@ -167,10 +179,7 @@ package body System.Value_D is
 
       else
          declare
-            B : constant Int     := Int (Base);
-            S : constant Integer := ScaleB;
-
-            V : Uns := Val;
+            B : constant Int := Int (Base);
 
             Y, Z, Q, R : Int;
 
@@ -186,7 +195,10 @@ package body System.Value_D is
                   Z := Safe_Expont (B, LS, 10 ** Integer'Max (0, -Scale));
 
                   for J in 1 .. LS loop
-                     V := V / Uns (B);
+                     if V = 0 then
+                        exit;
+                     end if;
+                     V := V / Uns (Base);
                   end loop;
                end;
 
@@ -201,8 +213,8 @@ package body System.Value_D is
                   Z := 10 ** Integer'Max (0, -Scale);
 
                   for J in 1 .. LS loop
-                     if V <= (Uns'Last - E) / Uns (B) then
-                        V := V * Uns (B) + E;
+                     if V <= (Uns'Last - Uns (E)) / Uns (Base) then
+                        V := V * Uns (Base) + Uns (E);
                         E := 0;
                      else
                         Bad_Value (Str);

diff --git a/gcc/ada/libgnat/s-valuef.adb b/gcc/ada/libgnat/s-valuef.adb
index 03821aa4c1f584760783c607b44502754a919a0f..6ea22117432de50f6d78deb38840f049d23fa256 100644 (file)
--- a/gcc/ada/libgnat/s-valuef.adb
+++ b/gcc/ada/libgnat/s-valuef.adb
@@ -236,8 +236,8 @@ package body System.Value_F is
       --  but here we cannot handle 2**(Int'Size - 1) if Minus is not set.
 
       if V = 2**(Int'Size - 1) and then not Minus then
-         E := Unsigned (V rem Uns (B)) * Base + E / Base;
-         V := V / Uns (B);
+         E := Unsigned (V rem Uns (Base)) * Base + E / Base;
+         V := V / Uns (Base);
          S := S + 1;
       end if;
 
@@ -261,8 +261,8 @@ package body System.Value_F is
                   E := 0;
                   exit;
                end if;
-               E := Unsigned (V rem Uns (B)) * Base + E / Base;
-               V := V / Uns (B);
+               E := Unsigned (V rem Uns (Base)) * Base + E / Base;
+               V := V / Uns (Base);
             end loop;
          end;
 
@@ -277,8 +277,8 @@ package body System.Value_F is
             Z := Num;
 
             for J in 1 .. LS loop
-               if V <= (Uns'Last - Uns (E / Base)) / Uns (B) then
-                  V := V * Uns (B) + Uns (E / Base);
+               if V <= (Uns'Last - Uns (E / Base)) / Uns (Base) then
+                  V := V * Uns (Base) + Uns (E / Base);
                   E := (E rem Base) * Base;
                else
                   Bad_Value (Str);