From 4123b473427ca6854f874c77f5ce78c7e8c133a7 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 22 Jul 2019 13:56:40 +0000 Subject: [PATCH] [Ada] Incorrect values in conversion from fixed-point subtype with 'Small This patch fixes incorrect computations involving a fixed-point subtype whose parent type has an aspect specification for 'Small. Executing the following: gnatmake -q conv ./conv must yield: 9000.000000 9.00000000000000E+03 9000.000000 9.00000000000000E+03 9.00000000000000E+03 9.00000000000000E+03 9.00000000000000E+03 9.00000000000000E+03 ---- with Text_IO; use Text_IO; procedure Conv is V_P : constant := 10.0 ** (-6); M_V : constant := 9000.0; N_V : constant := -9000.0; type V_T is delta V_P range N_V .. M_V with Small => V_P; subtype S_T is V_T range 0.0 .. M_V; function Convert (Input : in S_T) return Long_Float is begin Put_Line (Input'Img); Put_Line (Long_Float'Image (Long_Float (Input))); return Long_Float (Input); end Convert; begin declare Var_S : constant S_T := S_T'Last; Output : constant Long_Float := Convert (Var_S); begin Put_Line (Long_Float'Image (Convert (Var_S))); Put_Line (Long_Float'Image (Long_Float (Var_S))); Put_Line (Output'Img); end; Put_Line (Long_Float'Image (Long_Float (S_T'Last))); end Conv; 2019-07-22 Ed Schonberg gcc/ada/ * freeze.adb (Freeze_Fixed_Point_Type): When freezing a fixed-point subtype, check whether the parent type declarastion includes an aspect specification for the 'Small type attribute, and inherit the specified value. From-SVN: r273671 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/freeze.adb | 11 +++++++++++ 2 files changed, 18 insertions(+) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5cb3ab499e5..5113e77fea2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-22 Ed Schonberg + + * freeze.adb (Freeze_Fixed_Point_Type): When freezing a + fixed-point subtype, check whether the parent type declarastion + includes an aspect specification for the 'Small type attribute, + and inherit the specified value. + 2019-07-22 Javier Miranda * freeze.adb (Freeze_Subprogram): Check that C++ constructors diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 728eaf2789f..00d20e90169 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -8003,6 +8003,7 @@ 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); Loval : Ureal; Hival : Ureal; @@ -8055,6 +8056,16 @@ 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. -- 2.30.2