From: Ed Schonberg <schonberg@adacore.com>
Date: Wed, 18 Sep 2019 08:33:40 +0000 (+0000)
Subject: [Ada] Crash on universal case expression in fixed-point division
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1784b1eb1f22a802cf7e2f3529fa83a40bce1b20;p=gcc.git

[Ada] Crash on universal case expression in fixed-point division

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.

2019-09-18  Ed Schonberg  <schonberg@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.

From-SVN: r275864
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d9b552ae531..2a5ca047355 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2019-09-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* 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.
+
 2019-09-18  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch3.adb (Constrain_Component_Type): For a discriminated
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 7a52b90c98f..38de57d6cf5 100644
--- a/gcc/ada/sem_res.adb
+++ b/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);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cc189697a97..7cfdc4cbb2a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-09-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/fixedpnt8.adb: New testcase.
+
 2019-09-18  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/discr58.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/fixedpnt8.adb b/gcc/testsuite/gnat.dg/fixedpnt8.adb
new file mode 100644
index 00000000000..1fc5cef0a75
--- /dev/null
+++ b/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