This patch fixes a compiler abort on a subtype of a fixed-point type
with a 'Small smaller than one. The bounds of a declared subtype of a
fixed-point type where rescaled twice, leading to meaningless values
(constraint-violating) for those bounds.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

        * freeze.adb (Freeze_Fixed_Point_Type): Do not scale the bounds
        of a declared subtype using the 'Small of the type;  this is
        done during resolution of the bound itself, unlike what is done
        for the bounds of the base type, which are used to determine its
        required size. Previous code performed this scaling twice,
        leading to meaningless values for such a subtype.
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -8494,21 +8494,21 @@ package body Freeze is
       Set_Analyzed (Lo, False);
       Analyze (Lo);
 
-      --  Resolve with universal fixed if the base type, and the base type if
-      --  it is a subtype. Note we can't resolve the base type with itself,
-      --  that would be a reference before definition.
+      --  Resolve with universal fixed if the base type, and with the base
+      --  type if we are freezing a subtype. Note we can't resolve the base
+      --  type with itself, that would be a reference before definition.
+      --  The resolution of the bounds of a subtype, if they are given by real
+      --  literals,  includes the setting of the Corresponding_Integer_Value,
+      --  as for other literals of a fixed-point type.
 
       if Typ = Btyp then
          Resolve (Lo, Universal_Fixed);
+         Set_Corresponding_Integer_Value
+           (Lo, UR_To_Uint (Realval (Lo) / Small));
       else
          Resolve (Lo, Btyp);
       end if;
 
-      --  Set corresponding integer value for bound
-
-      Set_Corresponding_Integer_Value
-        (Lo, UR_To_Uint (Realval (Lo) / Small));
-
       --  Similar processing for high bound
 
       Set_Etype (Hi, Empty);
@@ -8517,13 +8517,12 @@ package body Freeze is
 
       if Typ = Btyp then
          Resolve (Hi, Universal_Fixed);
+         Set_Corresponding_Integer_Value
+           (Hi, UR_To_Uint (Realval (Hi) / Small));
       else
          Resolve (Hi, Btyp);
       end if;
 
-      Set_Corresponding_Integer_Value
-        (Hi, UR_To_Uint (Realval (Hi) / Small));
-
       --  Set type of range to correspond to bounds
 
       Set_Etype (Rng, Etype (Lo));


Reply via email to