[Ada] Crash on aggregate with dscriminant in if-expression as default

This patch fixes a crash on a an aggregate for a discriminated type,
when a component of the aggregate is also a discriminated type
constrained by a discriminant of the enclosing object, and the default
value for the component is a conditional expression that includes
references to that outer discriminant.

2019-09-18  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_aggr.adb (Expand_Record_Aggregate, Rewrite_Discriminant):
	After rewriting a reference to an outer discriminant as a
	selected component of the enclosing object, analyze the selected
	component to ensure that the entity of the selector name is
	properly set. This is necessary when the aggregate appears
	within an expression that may have been analyzed already.

gcc/testsuite/

	* gnat.dg/discr58.adb: New testcase.

From-SVN: r275862
This commit is contained in:
Ed Schonberg 2019-09-18 08:33:27 +00:00 committed by Pierre-Marie de Rodat
parent 483af72e4b
commit b8411279b0
4 changed files with 53 additions and 0 deletions

View File

@ -1,3 +1,12 @@
2019-09-18 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Expand_Record_Aggregate, Rewrite_Discriminant):
After rewriting a reference to an outer discriminant as a
selected component of the enclosing object, analyze the selected
component to ensure that the entity of the selector name is
properly set. This is necessary when the aggregate appears
within an expression that may have been analyzed already.
2019-09-18 Justin Squirek <squirek@adacore.com>
* sem_ch8.adb (Use_One_Type): Add guard to prevent warning on a

View File

@ -3103,6 +3103,13 @@ package body Exp_Aggr is
Make_Selected_Component (Loc,
Prefix => New_Copy_Tree (Lhs),
Selector_Name => Make_Identifier (Loc, Chars (Expr))));
-- The generated code will be reanalyzed, but if the reference
-- to the discriminant appears within an already analyzed
-- expression (e.g. a conditional) we must set its proper entity
-- now. Context is an initialization procedure.
Analyze (Expr);
end if;
return OK;

View File

@ -1,3 +1,7 @@
2019-09-18 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/discr58.adb: New testcase.
2019-09-18 Justin Squirek <squirek@adacore.com>
* gnat.dg/warn30.adb, gnat.dg/warn30.ads: New testcase.

View File

@ -0,0 +1,33 @@
-- { dg-do compile }
with Ada.Text_IO; use Ada.Text_IO;
procedure Discr58 is
type Field(Flag : Boolean := True) is record
case Flag is
when True => Param1 : Boolean := False;
when False => Param2 : Boolean := True;
end case;
end record;
type Header(Flag : Boolean := True) is record
Param3 : Integer := 0;
Params : Field(Flag) := (if Flag = True then
(Flag => True, others => <>)
else
(Flag => False, others => <>));
end record;
type Message(Flag : Boolean) is record
-- This assignment crashes GNAT
The_Header : Header(Flag) := Header'(Flag => True, others => <>);
end record;
It : Message (True);
begin
Put_Line("Hello World");
Put_Line (Boolean'Image (It.The_Header.Flag));
Put_Line (Boolean'Image (It.The_Header.Params.Flag));
end Discr58;