[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5cb3ab499e55c3e45bc2f90e415814879d6982b9..5113e77fea285cdfd378cbd0665186c56ea212c5 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 728eaf2789f1c7560f0b7335faa035aaa4b05a37..00d20e9016928ba870becc803e230ba6050aa26e 100644 (file)
--- 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.