public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-5684] [Ada] Fix incorrect fixed-point computation in expression function
@ 2021-12-01 10:27 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-12-01 10:27 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:82a7daa31a31922bbe44a878cd0313c048a02130
commit r12-5684-g82a7daa31a31922bbe44a878cd0313c048a02130
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri Nov 19 18:24:01 2021 +0100
[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.
Diff:
---
gcc/ada/einfo.ads | 2 +-
gcc/ada/freeze.adb | 39 +++++++++++++++++----------------------
gcc/ada/sem_res.adb | 12 +++++++++---
3 files changed, 27 insertions(+), 26 deletions(-)
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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-12-01 10:27 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-12-01 10:27 [gcc r12-5684] [Ada] Fix incorrect fixed-point computation in expression function Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).