[Ada] Fix missing check for no-op conversion to fixed-point type

[Ada] Fix missing check for no-op conversion to fixed-point type

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 812 bytes --]

This plugs a small loophole in the compiler for the case of a
multiplication or a division in a fixed-point type wrapped in a no-op
conversion, e.g. to the same fixed-point type.

The front-end fails to generate a range check for the operation.  This
used to be caught by the back-end, which would generate the range check,
but this is no longer the case because we now make sure to reset the
Do_Range_Check flag in all cases before invoking the back-end.

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch4.adb (Expand_N_Type_Conversion): Beef up comment.
	(Fixup_Universal_Fixed_Operation): Set the base type instead of
	the type of the enclosing type conversion on the operation.

gcc/testsuite/

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

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 1694 bytes --]

--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -12072,7 +12072,10 @@ package body Exp_Ch4 is
       --  Check: are these rules stated in sinfo??? if so, why restate here???
 
       --  The only remaining step is to generate a range check if we still have
-      --  a type conversion at this stage and Do_Range_Check is set.
+      --  a type conversion at this stage and Do_Range_Check is set. Note that
+      --  we need to deal with at most 8 out of the 9 possible cases of numeric
+      --  conversions here, because the float-to-integer case is entirely dealt
+      --  with by Apply_Float_Conversion_Check.
 
       if Nkind (N) = N_Type_Conversion
         and then Do_Range_Check (Expression (N))
@@ -12726,13 +12729,13 @@ package body Exp_Ch4 is
       if Nkind (Parent (Conv)) = N_Attribute_Reference
         and then Attribute_Name (Parent (Conv)) = Name_Round
       then
-         Set_Etype (N, Etype (Parent (Conv)));
+         Set_Etype (N, Base_Type (Etype (Parent (Conv))));
          Set_Rounded_Result (N);
 
       --  Normal case where type comes from conversion above us
 
       else
-         Set_Etype (N, Etype (Conv));
+         Set_Etype (N, Base_Type (Etype (Conv)));
       end if;
    end Fixup_Universal_Fixed_Operation;
 

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/fixedpnt6.adb
@@ -0,0 +1,21 @@
+--  { dg-do run }
+--  { dg-options "-O0" }
+
+procedure Fixedpnt6 is
+
+  type T is delta 0.125 range -2.0 .. 1.875;
+
+  function Mult (A, B : T) return T is
+  begin
+    return T (A * B);
+  end;
+
+  R : T;
+
+begin
+  R := Mult (T'Last, T'Last);
+  raise Program_Error;
+exception
+   when Constraint_Error =>
+      null;
+end;