[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  <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.

From-SVN: r273671
This commit is contained in:
Ed Schonberg 2019-07-22 13:56:40 +00:00 committed by Pierre-Marie de Rodat
parent 2fdc20b65c
commit 4123b47342
2 changed files with 18 additions and 0 deletions

View File

@ -1,3 +1,10 @@
2019-07-22 Ed Schonberg <schonberg@adacore.com>
* 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 <miranda@adacore.com>
* freeze.adb (Freeze_Subprogram): Check that C++ constructors

View File

@ -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.