diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 4f748703209..ca2ba203353 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -5353,7 +5353,7 @@ package Einfo is -- Size_Clause (synth) -- E_Decimal_Fixed_Point_Type - -- E_Decimal_Fixed_Subtype$$$no such thing + -- E_Decimal_Fixed_Point_Subtype -- Scale_Value -- Digits_Value -- Scalar_Range diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 4d099566902..ad841cf14e3 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -8997,8 +8997,9 @@ package body Freeze is Brng : constant Node_Id := Scalar_Range (Btyp); BLo : constant Node_Id := Low_Bound (Brng); BHi : constant Node_Id := High_Bound (Brng); - Par : constant Entity_Id := First_Subtype (Typ); - Small : constant Ureal := Small_Value (Typ); + Ftyp : constant Entity_Id := Underlying_Type (First_Subtype (Typ)); + + Small : Ureal; Loval : Ureal; Hival : Ureal; Atype : Entity_Id; @@ -9037,7 +9038,7 @@ package body Freeze is function Larger (A, B : Ureal) return Boolean is begin - return A > B and then A - Small > B; + return A > B and then A - Small_Value (Typ) > B; end Larger; ------------- @@ -9046,7 +9047,7 @@ package body Freeze is function Smaller (A, B : Ureal) return Boolean is begin - return A < B and then A + Small < B; + return A < B and then A + Small_Value (Typ) < B; end Smaller; -- Start of processing for Freeze_Fixed_Point_Type @@ -9057,9 +9058,15 @@ package body Freeze is -- so that all characteristics of the type (size, bounds) can be -- computed and validated in the call to Minimum_Size that follows. - if Has_Delayed_Aspects (First_Subtype (Typ)) then - Analyze_Aspects_At_Freeze_Point (First_Subtype (Typ)); - Set_Has_Delayed_Aspects (First_Subtype (Typ), False); + if Has_Delayed_Aspects (Ftyp) then + Analyze_Aspects_At_Freeze_Point (Ftyp); + Set_Has_Delayed_Aspects (Ftyp, False); + end if; + + -- Inherit the Small value from the first subtype in any case + + if Typ /= Ftyp then + Set_Small_Value (Typ, Small_Value (Ftyp)); end if; -- If Esize of a subtype has not previously been set, set it now @@ -9074,16 +9081,6 @@ package body Freeze is end if; end if; - -- The 'small attribute may have been specified with an aspect, - -- in which case it is processed after a subtype declaration, so - -- inherit now the specified value. - - if Typ /= Par - and then Present (Find_Aspect (Par, Aspect_Small)) - then - Set_Small_Value (Typ, Small_Value (Par)); - end if; - -- Immediate return if the range is already analyzed. This means that -- the range is already set, and does not need to be computed by this -- routine. @@ -9100,6 +9097,7 @@ package body Freeze is return; end if; + Small := Small_Value (Typ); Loval := Realval (Lo); Hival := Realval (Hi); @@ -9137,7 +9135,6 @@ package body Freeze is Size_Excl_EP : Int; Model_Num : Ureal; - First_Subt : Entity_Id; Actual_Lo : Ureal; Actual_Hi : Ureal; @@ -9279,10 +9276,8 @@ package body Freeze is -- to get a base type whose size is smaller than the specified -- size of the first subtype. - First_Subt := First_Subtype (Typ); - - if Has_Size_Clause (First_Subt) - and then Size_Incl_EP <= Esize (First_Subt) + if Has_Size_Clause (Ftyp) + and then Size_Incl_EP <= Esize (Ftyp) then Actual_Size := Size_Incl_EP; Actual_Lo := Loval_Incl_EP; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index ac262facfec..84612c3d7ba 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -10765,17 +10765,23 @@ package body Sem_Res is begin -- Special processing for fixed-point literals to make sure that the - -- value is an exact multiple of small where this is required. We skip - -- this for the universal real case, and also for generic types. + -- value is an exact multiple of the small where this is required. We + -- skip this for the universal real case, and also for generic types. if Is_Fixed_Point_Type (Typ) and then Typ /= Universal_Fixed and then Typ /= Any_Fixed and then not Is_Generic_Type (Typ) then + -- We must freeze the base type to get the proper value of the small + + if not Is_Frozen (Base_Type (Typ)) then + Freeze_Fixed_Point_Type (Base_Type (Typ)); + end if; + declare Val : constant Ureal := Realval (N); - Cintr : constant Ureal := Val / Small_Value (Typ); + Cintr : constant Ureal := Val / Small_Value (Base_Type (Typ)); Cint : constant Uint := UR_Trunc (Cintr); Den : constant Uint := Norm_Den (Cintr); Stat : Boolean;