[gcc r15-6189] ada: Remove implicit assumption in the double case

[Marc Poulhi?s via Gcc-cvs]

https://gcc.gnu.org/g:83b250bf58f681aff7a6856579cfd89e759b2a93

commit r15-6189-g83b250bf58f681aff7a6856579cfd89e759b2a93
Author: Eric Botcazou <ebotca...@adacore.com>
Date:   Tue Nov 26 21:20:08 2024 +0100

    ada: Remove implicit assumption in the double case
    
    The assumption is fulfilled in all the instantiations of the package, but
    it should not be made in the generic code.
    
    gcc/ada/ChangeLog:
    
            * libgnat/s-imager.adb (Set_Image_Real): In the case where a double
            integer is needed, do not implicit assume that it can contain up to
            'Digits of the floating-point type.

Diff:
---
 gcc/ada/libgnat/s-imager.adb | 23 ++++++++++++++++-------
 1 file changed, 16 insertions(+), 7 deletions(-)

diff --git a/gcc/ada/libgnat/s-imager.adb b/gcc/ada/libgnat/s-imager.adb
index 89f9c1b020a3..f30478843a87 100644
--- a/gcc/ada/libgnat/s-imager.adb
+++ b/gcc/ada/libgnat/s-imager.adb
@@ -432,30 +432,39 @@ package body System.Image_R is
 
          --  Otherwise, do the conversion in two steps
 
-         else pragma Assert (X <= 10.0 ** Num'Digits * Num (Uns'Last));
+         else
             declare
-               Y : constant Uns := To_Unsigned (X / Powten (Num'Digits));
+               Halfdigs : constant Natural := Maxdigs / 2;
 
-               Buf : String (1 .. Num'Digits);
+               Buf : String (1 .. Halfdigs);
                Len : Natural;
+               Y   : Uns;
 
             begin
+               --  Compute upper Halfdigs stripped from leading zeros
+
+               Y := To_Unsigned (X / Powten (Halfdigs));
                Set_Image_Unsigned (Y, Digs, Ndigs);
 
-               X := X - From_Unsigned (Y) * Powten (Num'Digits);
+               --  Compute lower Halfdigs stripped from leading zeros
 
                Len := 0;
+               X := X - From_Unsigned (Y) * Powten (Halfdigs);
                Set_Image_Unsigned (To_Unsigned (X), Buf, Len);
+               pragma Assert (Len <= Halfdigs);
+
+               --  Concatenate unmodified upper part with zero-padded
+               --  lower part up to Halfdigs.
 
-               for J in 1 .. Num'Digits - Len loop
+               for J in 1 .. Halfdigs - Len loop
                   Digs (Ndigs + J) := '0';
                end loop;
 
                for J in 1 .. Len loop
-                  Digs (Ndigs + Num'Digits - Len + J) := Buf (J);
+                  Digs (Ndigs + Halfdigs - Len + J) := Buf (J);
                end loop;
 
-               Ndigs := Ndigs + Num'Digits;
+               Ndigs := Ndigs + Halfdigs;
             end;
          end if;
       end if;