@@ -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.
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; Tested on x86_64-pc-linux-gnu, committed on trunk 2019-07-22 Ed Schonberg <schonberg@adacore.com> 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.