[Ada] Better accuracy in float-to-fixed conversions

This patch improves the accuracy of conversions from a floating point to
a fixed point type when the fixed point type has a specified Snall that is
not a power of two. Previously the conversion of Fixed_Point_Type'First to
some floating point number and back to Fixed_Point_Type raised Constraint
error. This result is within the accuracy imposed by tne Numerics annex of
the RM but is certainly undesirable. This patch transforms the conversion
to avoid extra manipulations of the 'Small of the type, so that the
identity:

      Fixed_T (Float_T (Fixed_Val)) = Fixed_Val

holds over the range of Fixed_T.

2018-05-28  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_ch4.adb (Real_Range_Check): Specialize float-to-fixed conversions
	when bounds of fixed type are static, to remove some spuerfluous
	implicit conversions and provide an accurate result when converting
	back and forth between the fixed point type and a floating point type.

gcc/testsuite/

	* gnat.dg/fixedpnt5.adb: New testcase.

From-SVN: r260832

gcc/ada/ChangeLog

 2018-05-28  Ed Schonberg  <schonberg@adacore.com>
 
+	* exp_ch4.adb (Real_Range_Check): Specialize float-to-fixed conversions
+	when bounds of fixed type are static, to remove some spuerfluous
+	implicit conversions and provide an accurate result when converting
+	back and forth between the fixed point type and a floating point type.
+
+2018-05-28  Ed Schonberg  <schonberg@adacore.com>
+
 	* exp_unst.adb (Unnest_Subprogram): Prevent creation of empty
 	activation records.
 

gcc/ada/exp_ch4.adb

@@ -10937,8 +10937,13 @@ package body Exp_Ch4 is
          Lo   : constant Node_Id   := Type_Low_Bound  (Target_Type);
          Hi   : constant Node_Id   := Type_High_Bound (Target_Type);
          Xtyp : constant Entity_Id := Etype (Operand);
-         Conv : Node_Id;
-         Tnn  : Entity_Id;
+
+         Conv   : Node_Id;
+         Lo_Arg : Node_Id;
+         Lo_Val : Node_Id;
+         Hi_Arg : Node_Id;
+         Hi_Val : Node_Id;
+         Tnn    : Entity_Id;
 
       begin
          --  Nothing to do if conversion was rewritten
@@ -11041,34 +11046,108 @@ package body Exp_Ch4 is
 
          Tnn := Make_Temporary (Loc, 'T', Conv);
 
+         --  For a conversion from Float to Fixed where the bounds of the
+         --  fixed-point type are static, we can obtain a more accurate
+         --  fixed-point value by converting the result of the floating-
+         --  point expression to an appropriate integer type, and then
+         --  performing an unchecked conversion to the target fixed-point
+         --  type. The range check can then use the corresponding integer
+         --  value of the bounds instead of requiring further conversions.
+         --  This preserves the identity:
+
+         --        Fix_Val = Fixed_Type (Float_Type (Fix_Val))
+
+         --  which used to fail when Fix_Val was a bound of the type and
+         --  the 'Small was not a representable number.
+         --  This transformation requires an integer type large enough to
+         --  accommodate a fixed-point value. This will not be the case
+         --  in systems where Duration is larger than Long_Integer.
+
+         if Is_Ordinary_Fixed_Point_Type (Target_Type)
+           and then Is_Floating_Point_Type (Operand_Type)
+           and then RM_Size (Base_Type (Target_Type)) <=
+             RM_Size (Standard_Long_Integer)
+           and then Nkind (Lo) = N_Real_Literal
+           and then Nkind (Hi) = N_Real_Literal
+         then
+            --  Find the integer type of the right size to perform an unchecked
+            --  conversion to the target fixed-point type.
+
+            declare
+               Int_Type : Entity_Id;
+               Bfx_Type : constant Entity_Id := Base_Type (Target_Type);
+
+            begin
+               if RM_Size (Bfx_Type) > RM_Size (Standard_Integer) then
+                  Int_Type := Standard_Long_Integer;
+
+               elsif
+                 RM_Size (Bfx_Type) > RM_Size (Standard_Short_Integer)
+               then
+                  Int_Type := Standard_Integer;
+
+               else
+                  Int_Type := Standard_Short_Integer;
+               end if;
+
+               --  Create integer objects for range checking of result.
+
+               Lo_Arg := Unchecked_Convert_To (Int_Type,
+                           New_Occurrence_Of (Tnn, Loc));
+               Lo_Val := Make_Integer_Literal (Loc,
+                           Corresponding_Integer_Value (Lo));
+
+               Hi_Arg := Unchecked_Convert_To (Int_Type,
+                           New_Occurrence_Of (Tnn, Loc));
+               Hi_Val := Make_Integer_Literal (Loc,
+                           Corresponding_Integer_Value (Hi));
+
+               --  Rewrite conversion as an integer conversion of the
+               --  original floating-point expression, followed by an
+               --  unchecked conversion to the target fixed-point type.
+
+               Conv   := Make_Unchecked_Type_Conversion (Loc,
+                           Subtype_Mark =>
+                             New_Occurrence_Of (Target_Type, Loc),
+                           Expression   =>
+                             Convert_To (Int_Type, Expression (Conv)));
+            end;
+
+         else  -- For all other conversions
+
+            Lo_Arg := New_Occurrence_Of (Tnn, Loc);
+            Lo_Val := Make_Attribute_Reference (Loc,
+                       Attribute_Name => Name_First,
+                         Prefix =>
+                           New_Occurrence_Of (Target_Type, Loc));
+
+            Hi_Arg := New_Occurrence_Of (Tnn, Loc);
+            Hi_Val := Make_Attribute_Reference (Loc,
+                       Attribute_Name => Name_Last,
+                         Prefix =>
+                           New_Occurrence_Of (Target_Type, Loc));
+         end if;
+
+         --  Build code for range checking
+
          Insert_Actions (N, New_List (
            Make_Object_Declaration (Loc,
              Defining_Identifier => Tnn,
              Object_Definition   => New_Occurrence_Of (Btyp, Loc),
              Constant_Present    => True,
              Expression          => Conv),
-
            Make_Raise_Constraint_Error (Loc,
-             Condition =>
+              Condition =>
               Make_Or_Else (Loc,
-                Left_Opnd =>
                   Make_Op_Lt (Loc,
-                    Left_Opnd  => New_Occurrence_Of (Tnn, Loc),
-                    Right_Opnd =>
-                      Make_Attribute_Reference (Loc,
-                        Attribute_Name => Name_First,
-                        Prefix =>
-                          New_Occurrence_Of (Target_Type, Loc))),
+                    Left_Opnd  => Lo_Arg,
+                    Right_Opnd => Lo_Val),
 
                 Right_Opnd =>
                   Make_Op_Gt (Loc,
-                    Left_Opnd  => New_Occurrence_Of (Tnn, Loc),
-                    Right_Opnd =>
-                      Make_Attribute_Reference (Loc,
-                        Attribute_Name => Name_Last,
-                        Prefix =>
-                          New_Occurrence_Of (Target_Type, Loc)))),
-             Reason => CE_Range_Check_Failed)));
+                    Left_Opnd  => Hi_Arg,
+                    Right_Opnd => Hi_Val)),
+              Reason => CE_Range_Check_Failed)));
 
          Rewrite (N, New_Occurrence_Of (Tnn, Loc));
          Analyze_And_Resolve (N, Btyp);

gcc/testsuite/ChangeLog

+2018-05-28  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/fixedpnt5.adb: New testcase.
+
 2018-05-28  Justin Squirek  <squirek@adacore.com>
 
 	* gnat.dg/array31.adb: New testcase.

gcc/testsuite/gnat.dg/fixedpnt5.adb

+--  { dg-do run }
+
+with Text_IO; use Text_IO;
+with Ada.Numerics; use Ada.Numerics;
+with Unchecked_Conversion;
+
+procedure Fixedpnt5 is
+   --  Test conversions from Floating point to Fixed point types when the
+   --  fixed type has a Small that is not a power of two. Verify that the
+   --  conversions are reversible, so that:
+   --
+   --        Fixed_T (Float_T (Fixed_Var)) = Fixed_Var
+   --
+   --  for a range of fixed values, in particular at the boundary of type.
+
+   type T_Fixed_Type is delta PI/32768.0 range -PI .. PI - PI/32768.0;
+   for T_Fixed_Type'Small use PI/32768.0;
+
+   function To_Fix is new Unchecked_Conversion (Short_Integer, T_Fixed_Type);
+   Fixed_Point_Var : T_Fixed_Type;
+   Float_Var       : Float;
+
+begin
+   Fixed_Point_Var := -PI;
+   Float_Var       := Float(Fixed_Point_Var);
+   Fixed_Point_Var := T_Fixed_Type (Float_Var);
+
+   Fixed_Point_Var := T_Fixed_Type'First;
+   Float_Var       := Float(Fixed_Point_Var);
+   Fixed_Point_Var := T_Fixed_Type (Float_Var);
+
+   if Fixed_Point_Var /= T_Fixed_Type'First then
+      raise Program_Error;
+   end if;
+
+   fixed_point_var := t_fixed_type'Last;
+   Float_Var       := Float(Fixed_Point_Var);
+   Fixed_Point_Var := T_Fixed_Type (Float_Var);
+
+   if Fixed_Point_Var /= T_Fixed_Type'Last then
+      raise Program_Error;
+   end if;
+
+   for I in  -32768 ..  32767 loop
+      fixed_Point_Var := To_Fix (Short_Integer (I));
+      Float_Var := Float (Fixed_Point_Var);
+      if T_Fixed_Type (Float_Var) /= FIxed_Point_Var then
+         Put_Line ("Not reversibloe");
+         Put_Line (Integer'Image (I));
+         raise Program_Error;
+      end if;
+   end loop;
+
+   Fixed_Point_Var := T_Fixed_Type (Float_Var * 2.0);
+   raise Program_Error;
+exception
+   when others => null;
+end Fixedpnt5;