Commit 1784b1eb by Ed Schonberg Committed by Pierre-Marie de Rodat

[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
parent 0cff31f0
2019-09-18 Ed Schonberg <schonberg@adacore.com> 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 * sem_ch3.adb (Constrain_Component_Type): For a discriminated
type, handle the case of a constraint given by a conversion of a type, handle the case of a constraint given by a conversion of a
discriminant of the enclosing type. Necessary when compiling a discriminant of the enclosing type. Necessary when compiling a
......
...@@ -5674,13 +5674,21 @@ package body Sem_Res is ...@@ -5674,13 +5674,21 @@ package body Sem_Res is
-- A universal real conditional expression can appear in a fixed-type -- A universal real conditional expression can appear in a fixed-type
-- context and must be resolved with that context to facilitate the -- 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) elsif Nkind_In (N, N_Case_Expression, N_If_Expression)
and then Etype (N) = Universal_Real and then Etype (N) = Universal_Real
and then Is_Fixed_Point_Type (B_Typ) and then Is_Fixed_Point_Type (B_Typ)
then then
if B_Typ = Universal_Fixed then
Resolve (N, Unique_Fixed_Point_Type (N));
else
Resolve (N, B_Typ); Resolve (N, B_Typ);
end if;
else else
Resolve (N); Resolve (N);
......
2019-09-18 Ed Schonberg <schonberg@adacore.com> 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. * gnat.dg/discr58.adb: New testcase.
2019-09-18 Justin Squirek <squirek@adacore.com> 2019-09-18 Justin Squirek <squirek@adacore.com>
......
-- { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment