From 1784b1eb1f22a802cf7e2f3529fa83a40bce1b20 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 18 Sep 2019 08:33:40 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_res.adb | 12 ++++++++++-- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/fixedpnt8.adb | 28 ++++++++++++++++++++++++++++ 4 files changed, 50 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/fixedpnt8.adb 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 + + * 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 * 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 + + * gnat.dg/fixedpnt8.adb: New testcase. + 2019-09-18 Ed Schonberg * 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 -- 2.30.2