[gcc r16-1446] ada: Fix various issues in System.Value_F.Integer_To_Fixed function

[Marc Poulhies]

https://gcc.gnu.org/g:23987088010ddb2e875b199424bf5bdd75465fb0

commit r16-1446-g23987088010ddb2e875b199424bf5bdd75465fb0
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Wed Apr 2 10:02:18 2025 +0200

    ada: Fix various issues in System.Value_F.Integer_To_Fixed 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 some runtimes are compiled with -gnatp and would
    fail to raise Constraint_Error when the sum of the terms overflows an Int.
    
    The third issue is that the function takes a long time to deal with huge
    negative exponents.
    
    gcc/ada/ChangeLog:
    
            * libgnat/s-valuef.adb (Integer_To_Fixed): Enable overflow checks.
            Deal specifically with Val = 2**(Int'Size - 1) if Minus is not set.
            Exit the loop when V saturates to 0 in the case of (huge) negative
            exponents.

Diff:
---
 gcc/ada/libgnat/s-valuef.adb | 37 +++++++++++++++++++++++++++----------
 1 file changed, 27 insertions(+), 10 deletions(-)

diff --git a/gcc/ada/libgnat/s-valuef.adb b/gcc/ada/libgnat/s-valuef.adb
index 993074041af0..7baa3b31ff42 100644
--- a/gcc/ada/libgnat/s-valuef.adb
+++ b/gcc/ada/libgnat/s-valuef.adb
@@ -156,6 +156,9 @@ package body System.Value_F is
       pragma Assert (Num < 0 and then Den < 0);
       --  Accept only negative numbers to allow -2**(Int'Size - 1)
 
+      pragma Unsuppress (Overflow_Check);
+      --  Use overflow check to catch bad values
+
       function Safe_Expont
         (Base   : Int;
          Exp    : in out Natural;
@@ -224,38 +227,52 @@ package body System.Value_F is
 
       B : constant Int := Int (Base);
 
-      V : Uns := Val;
-      E : Uns := Uns (Extra);
+      V : Uns     := Val;
+      S : Integer := ScaleB;
+      E : Uns     := Uns (Extra);
 
       Y, Z, Q1, R1, Q2, R2 : Int;
 
    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 := V rem Uns (B);
+         V := V / Uns (B);
+         S := S + 1;
+      end if;
+
       --  We will use a scaled divide operation for which we must control the
       --  magnitude of operands so that an overflow exception is not unduly
       --  raised during the computation. The only real concern is the exponent.
 
-      --  If ScaleB is too negative, then drop trailing digits, but preserve
-      --  the last dropped digit.
+      --  If S is too negative, then drop trailing digits, but preserve the
+      --  last dropped digit, until V saturates to 0.
 
-      if ScaleB < 0 then
+      if S < 0 then
          declare
-            LS : Integer := -ScaleB;
+            LS : Integer := -S;
 
          begin
             Y := Den;
             Z := Safe_Expont (B, LS, Num);
 
             for J in 1 .. LS loop
+               if V = 0 then
+                  E := 0;
+                  exit;
+               end if;
                E := V rem Uns (B);
                V := V / Uns (B);
             end loop;
          end;
 
-      --  If ScaleB is too positive, then scale V up, which may then overflow
+      --  If S is too positive, then scale V up, which may then overflow
 
-      elsif ScaleB > 0 then
+      elsif S > 0 then
          declare
-            LS : Integer := ScaleB;
+            LS : Integer := S;
 
          begin
             Y := Safe_Expont (B, LS, Den);
@@ -271,7 +288,7 @@ package body System.Value_F is
             end loop;
          end;
 
-      --  If ScaleB is zero, then proceed directly
+      --  If S is zero, then proceed directly
 
       else
          Y := Den;