[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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@275862 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 682397277cc40a450b37b37a1f4af6921a7569a2..92782aab03148d07cd8835827a01d74064470168 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 5b2e0a554c00e0e7b46dfb86747b19ac76e3dc94..63f9d1a512a5878733847d6b5f92d676da0a8a00 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e9966b28145cc980a2b85b572d6926a964b57fbf..cc189697a97bfb7c3e8316bd738f8004aafef53b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gnat.dg/discr58.adb b/gcc/testsuite/gnat.dg/discr58.adb
new file mode 100644 (file)
index 0000000..bb6f5bf
--- /dev/null
+++ b/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