From: Eric Botcazou <ebotcazou@adacore.com>
Date: Tue, 26 Nov 2024 20:20:08 +0000 (+0100)
Subject: ada: Remove implicit assumption in the double case
X-Git-Tag: basepoints/gcc-16~3364
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=83b250bf58f681aff7a6856579cfd89e759b2a93;p=thirdparty%2Fgcc.git

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 --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;