aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2019-09-18 08:33:27 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-09-18 08:33:27 +0000
commitb8411279b0674cd76850b0fa8266e8db21724e0e (patch)
tree870d33909d2ed5dd5c09ae3ed6934a9e4fb96314
parent483af72e4bf2499fdbbf6b6e061318eaa9ba2b2d (diff)
downloadgcc-b8411279b0674cd76850b0fa8266e8db21724e0e.zip
gcc-b8411279b0674cd76850b0fa8266e8db21724e0e.tar.gz
gcc-b8411279b0674cd76850b0fa8266e8db21724e0e.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog9
-rw-r--r--gcc/ada/exp_aggr.adb7
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/discr58.adb33
4 files changed, 53 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6823972..92782aa 100644
--- 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 5b2e0a5..63f9d1a 100644
--- 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 e9966b2..cc18969 100644
--- 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
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