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

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

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 845 bytes --]

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.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 1728 bytes --]

--- gcc/ada/exp_aggr.adb
+++ gcc/ada/exp_aggr.adb
@@ -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;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/discr58.adb
@@ -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;
\ No newline at end of file