From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 03919385843B; Wed, 1 Dec 2021 10:27:41 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 03919385843B MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-5684] [Ada] Fix incorrect fixed-point computation in expression function X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/master X-Git-Oldrev: ba12deb95594b898094b199f9f5ec1a52542be6b X-Git-Newrev: 82a7daa31a31922bbe44a878cd0313c048a02130 Message-Id: <20211201102742.03919385843B@sourceware.org> Date: Wed, 1 Dec 2021 10:27:41 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 01 Dec 2021 10:27:42 -0000 https://gcc.gnu.org/g:82a7daa31a31922bbe44a878cd0313c048a02130 commit r12-5684-g82a7daa31a31922bbe44a878cd0313c048a02130 Author: Eric Botcazou 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;