[Ada] Fix incorrect fixed-point computation in expression function

gcc/ada/

	* einfo.ads (E_Decimal_Fixed_Point_Subtype): Fix pasto.
	* freeze.adb (Freeze_Fixed_Point_Type): Retrieve the underlying type
	of the first subtype and do not use a stale value of Small_Value.
	* sem_res.adb (Resolve_Real_Literal): In the case of a fixed-point
	type, make sure that the base type is frozen and use its Small_Value
	to compute the corresponding integer value of the literal.
This commit is contained in:
Eric Botcazou 2021-11-19 18:24:01 +01:00 committed by Pierre-Marie de Rodat
parent ba12deb955
commit 82a7daa31a
3 changed files with 27 additions and 26 deletions

View File

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

View File

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

View File

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