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 <ebotca...@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.
--- 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;