[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:
parent
ba12deb955
commit
82a7daa31a
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user