@@ -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);
new file mode 100644
@@ -0,0 +1,58 @@
+-- { 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;
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. Tested on x86_64-pc-linux-gnu, committed on trunk 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.