[Ada] Fix couple of bugs in the implementation of Round attribute

gcc/ada/

	* exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Round>:
	Adjust commentary and set the Rounded_Result flag on the type
	conversion node when the node is needed.
	* exp_ch4.adb (Expand_N_Type_Conversion): Minor tweak.
	(Fixup_Universal_Fixed_Operation): Look through the type conversion
	only when it is to Universal_Real.
	* exp_fixd.adb: Remove with and use clauses for Snames.
	(Build_Divide): Remove redundant test.
	(Expand_Convert_Float_To_Fixed): Use Rounded_Result flag on the
	node to set the truncation parameter.

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index b21592c78b22c595ccfdf867e21fd7a8fddb9a7b..ff3d54f7880181a0ed3f8ae69d5175915d7eaaf3 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -6196,20 +6196,19 @@ package body Exp_Attr is
       -- Round --
       -----------
 
-      --  The handling of the Round attribute is quite delicate. The processing
-      --  in Sem_Attr introduced a conversion to universal real, reflecting the
-      --  semantics of Round, but we do not want anything to do with universal
-      --  real at runtime, since this corresponds to using floating-point
-      --  arithmetic.
+      --  The handling of the Round attribute is delicate when the operand is
+      --  universal fixed. In this case, the processing in Sem_Attr introduced
+      --  a conversion to universal real, reflecting the semantics of Round,
+      --  but we do not want anything to do with universal real at run time,
+      --  since this corresponds to using floating-point arithmetic.
 
       --  What we have now is that the Etype of the Round attribute correctly
       --  indicates the final result type. The operand of the Round is the
       --  conversion to universal real, described above, and the operand of
       --  this conversion is the actual operand of Round, which may be the
-      --  special case of a fixed point multiplication or division (Etype =
-      --  universal fixed)
+      --  special case of a fixed point multiplication or division.
 
-      --  The exapander will expand first the operand of the conversion, then
+      --  The expander will expand first the operand of the conversion, then
       --  the conversion, and finally the round attribute itself, since we
       --  always work inside out. But we cannot simply process naively in this
       --  order. In the semantic world where universal fixed and real really
@@ -6217,14 +6216,13 @@ package body Exp_Attr is
       --  implementation world, where universal real is a floating-point type,
       --  we would get the wrong result.
 
-      --  So the approach is as follows. First, when expanding a multiply or
-      --  divide whose type is universal fixed, we do nothing at all, instead
-      --  deferring the operation till later.
-
-      --  The actual processing is done in Expand_N_Type_Conversion which
-      --  handles the special case of Round by looking at its parent to see if
-      --  it is a Round attribute, and if it is, handling the conversion (or
-      --  its fixed multiply/divide child) in an appropriate manner.
+      --  So the approach is as follows. When expanding a multiply or divide
+      --  whose type is universal fixed, Fixup_Universal_Fixed_Operation will
+      --  look up and skip the conversion to universal real if its parent is
+      --  a Round attribute, taking information from this attribute node. In
+      --  the other cases, Expand_N_Type_Conversion does the same by looking
+      --  at its parent to see if it is a Round attribute, before calling the
+      --  fixed-point expansion routine.
 
       --  This means that by the time we get to expanding the Round attribute
       --  itself, the Round is nothing more than a type conversion (and will
@@ -6232,8 +6230,12 @@ package body Exp_Attr is
       --  appropriate conversion operation.
 
       when Attribute_Round =>
-         Rewrite (N,
-           Convert_To (Etype (N), Relocate_Node (First (Exprs))));
+         if Etype (First (Exprs)) = Etype (N) then
+            Rewrite (N, Relocate_Node (First (Exprs)));
+         else
+            Rewrite (N, Convert_To (Etype (N), First (Exprs)));
+            Set_Rounded_Result (N);
+         end if;
          Analyze_And_Resolve (N);
 
       --------------

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index ecaeeb27ff67950627fcc8180dc903215073a868..91ae71efd211c1e2e866d5b39da1a0742f3fad1f 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -12556,9 +12556,9 @@ package body Exp_Ch4 is
            and then Nkind (Parent (N)) = N_Attribute_Reference
            and then Attribute_Name (Parent (N)) = Name_Round
          then
-            Set_Rounded_Result (N);
             Set_Etype (N, Etype (Parent (N)));
             Target_Type := Etype (N);
+            Set_Rounded_Result (N);
          end if;
 
          if Is_Fixed_Point_Type (Target_Type) then
@@ -13375,7 +13375,8 @@ package body Exp_Ch4 is
       --  will be to universal real, and our real type comes from the Round
       --  attribute (as well as an indication that we must round the result)
 
-      if Nkind (Parent (Conv)) = N_Attribute_Reference
+      if Etype (Conv) = Universal_Real
+        and then Nkind (Parent (Conv)) = N_Attribute_Reference
         and then Attribute_Name (Parent (Conv)) = Name_Round
       then
          Set_Etype (N, Base_Type (Etype (Parent (Conv))));

diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb
index 3bb7207bf00cef588a96557cacd180f42f539317..8edca447173e1ae2771628fcb0bdbe6d9b945790 100644 (file)
--- a/gcc/ada/exp_fixd.adb
+++ b/gcc/ada/exp_fixd.adb
@@ -37,7 +37,6 @@ with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
-with Snames;   use Snames;
 with Stand;    use Stand;
 with Tbuild;   use Tbuild;
 with Ttypes;   use Ttypes;
@@ -417,13 +416,9 @@ package body Exp_Fixd is
 
       --  The result is rounded if the target of the operation is decimal
       --  and Rounded_Result is set, or if the target of the operation
-      --  is an integer type.
+      --  is an integer type, as determined by Rounded_Result_Set.
 
-      if Is_Integer_Type (Etype (N))
-        or else Rounded_Result_Set (N)
-      then
-         Set_Rounded_Result (Rnode);
-      end if;
+      Set_Rounded_Result (Rnode, Rounded_Result_Set (N));
 
       --  One more check. We did the divide operation using the longer of
       --  the two sizes, which is reasonable. However, in the case where the
@@ -1792,11 +1787,9 @@ package body Exp_Fixd is
 
    procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
       Expr        : constant Node_Id   := Expression (N);
-      Orig_N      : constant Node_Id   := Original_Node (N);
       Result_Type : constant Entity_Id := Etype (N);
       Rng_Check   : constant Boolean   := Do_Range_Check (N);
       Small       : constant Ureal     := Small_Value (Result_Type);
-      Truncate    : Boolean;
 
    begin
       --  Optimize small = 1, where we can avoid the multiply completely
@@ -1811,15 +1804,6 @@ package body Exp_Fixd is
       --  round.
 
       else
-         if Is_Decimal_Fixed_Point_Type (Result_Type) then
-            Truncate :=
-              Nkind (Orig_N) /= N_Attribute_Reference
-                or else Get_Attribute_Id
-                          (Attribute_Name (Orig_N)) /= Attribute_Round;
-         else
-            Truncate := False;
-         end if;
-
          Set_Result
            (N     => N,
             Expr  =>
@@ -1828,7 +1812,8 @@ package body Exp_Fixd is
                  L => Fpt_Value (Expr),
                  R => Real_Literal (N, Ureal_1 / Small)),
             Rchk  => Rng_Check,
-            Trunc => Truncate);
+            Trunc => Is_Decimal_Fixed_Point_Type (Result_Type)
+                       and not Rounded_Result (N));
       end if;
    end Expand_Convert_Float_To_Fixed;