This patch fixes a compiler abort on a case expression whose
alternatives are universal_real constants, when the case expression is
an operand in a multiplication or division whose other operand is of a
fixed-point type.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-09-18 Ed Schonberg <schonb...@adacore.com>
gcc/ada/
* sem_res.adb (Set_Mixed_Node_Expression): If a conditional
expression has universal_real alternaitves and the context is
Universal_Fixed, as when it is an operand in a fixed-point
multiplication or division, resolve the expression with a
visible fixed-point type, which must be unique.
gcc/testsuite/
* gnat.dg/fixedpnt8.adb: New testcase.--- gcc/ada/sem_res.adb
+++ gcc/ada/sem_res.adb
@@ -5674,13 +5674,21 @@ package body Sem_Res is
-- A universal real conditional expression can appear in a fixed-type
-- context and must be resolved with that context to facilitate the
- -- code generation in the back end.
+ -- code generation in the back end. However, If the context is
+ -- Universal_fixed (i.e. as an operand of a multiplication/division
+ -- involving a fixed-point operand) the conditional expression must
+ -- resolve to a unique visible fixed_point type, normally Duration.
elsif Nkind_In (N, N_Case_Expression, N_If_Expression)
and then Etype (N) = Universal_Real
and then Is_Fixed_Point_Type (B_Typ)
then
- Resolve (N, B_Typ);
+ if B_Typ = Universal_Fixed then
+ Resolve (N, Unique_Fixed_Point_Type (N));
+
+ else
+ Resolve (N, B_Typ);
+ end if;
else
Resolve (N);
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/fixedpnt8.adb
@@ -0,0 +1,28 @@
+-- { dg-do compile }
+
+procedure Fixedpnt8 is
+
+ Ct_A : constant := 0.000_000_100;
+ Ct_B : constant := 0.000_000_025;
+
+ Ct_C : constant := 1_000;
+
+ type Number_Type is range 0 .. Ct_C;
+
+ subtype Index_Type is Number_Type range 1 .. Number_Type'Last;
+
+ type Kind_Enumerated_Type is
+ (A1,
+ A2);
+
+ Kind : Kind_Enumerated_Type := A1;
+
+ V : Duration := 10.0;
+
+ Last : constant Index_Type :=
+ Index_Type (V / (case Kind is -- { dg-warning "universal_fixed expression interpreted as type \"Standard.Duration\"" }
+ when A1 => Ct_B,
+ when A2 => Ct_A));
+begin
+ null;
+end Fixedpnt8;
\ No newline at end of file
