[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
This commit is contained in:
parent
0cff31f0f6
commit
1784b1eb1f
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
Loading…
Reference in New Issue