From: Hristian Kirtchev <kirtchev@adacore.com>
Date: Thu, 4 Jul 2019 08:06:19 +0000 (+0000)
Subject: [Ada] Assertion failure on Default_Initial_Condition
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=dd4d8a71980487ddb4ac6c1ad0a1b8fb6c143592;p=gcc.git

[Ada] Assertion failure on Default_Initial_Condition

This patch prevents the association of a Default_Initial_Condition with
an incomplete type whose full view is the private type or private
extension subject to the aspect/pragma.

2019-07-04  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* sem_util.adb (Propagate_DIC_Attributes): Do not propagate the
	Default_Initial_Condition attributes to an incomplete type.

gcc/testsuite/

	* gnat.dg/default_initial_condition.adb,
	gnat.dg/default_initial_condition_pack.adb,
	gnat.dg/default_initial_condition_pack.ads: New testcase.

From-SVN: r273059
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index be26421081d..2925c845081 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_util.adb (Propagate_DIC_Attributes): Do not propagate the
+	Default_Initial_Condition attributes to an incomplete type.
+
 2019-07-04  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_attr.adb (Check_Array_Type): An array type attribute such
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 4d19c614714..868e93ea955 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -23327,6 +23327,13 @@ package body Sem_Util is
 
          if From_Typ = Typ then
             return;
+
+         --  Nothing to do when the destination denotes an incomplete type
+         --  because the DIC is associated with the current instance of a
+         --  private type, thus it can never apply to an incomplete type.
+
+         elsif Is_Incomplete_Type (Typ) then
+            return;
          end if;
 
          DIC_Proc := DIC_Procedure (From_Typ);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index dd22271efe2..2b1a479fda8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-07-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* gnat.dg/default_initial_condition.adb,
+	gnat.dg/default_initial_condition_pack.adb,
+	gnat.dg/default_initial_condition_pack.ads: New testcase.
+
 2019-07-04  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/aspect2.adb, gnat.dg/aspect2.ads: New testcase.
diff --git a/gcc/testsuite/gnat.dg/default_initial_condition.adb b/gcc/testsuite/gnat.dg/default_initial_condition.adb
new file mode 100644
index 00000000000..5ba94a6b865
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/default_initial_condition.adb
@@ -0,0 +1,12 @@
+--  { dg-do run }
+--  { dg-options "-gnata" }
+
+with Default_Initial_Condition_Pack; use Default_Initial_Condition_Pack;
+
+procedure Default_Initial_Condition is
+   Obj : T;
+begin
+   if not DIC_Called then
+      raise Program_Error;
+   end if;
+end Default_Initial_Condition;
diff --git a/gcc/testsuite/gnat.dg/default_initial_condition_pack.adb b/gcc/testsuite/gnat.dg/default_initial_condition_pack.adb
new file mode 100644
index 00000000000..abcd491c394
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/default_initial_condition_pack.adb
@@ -0,0 +1,7 @@
+package body Default_Initial_Condition_Pack is
+   function Is_OK (Val : T) return Boolean is
+   begin
+      DIC_Called := True;
+      return True;
+   end Is_OK;
+end Default_Initial_Condition_Pack;
diff --git a/gcc/testsuite/gnat.dg/default_initial_condition_pack.ads b/gcc/testsuite/gnat.dg/default_initial_condition_pack.ads
new file mode 100644
index 00000000000..c461bf280bc
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/default_initial_condition_pack.ads
@@ -0,0 +1,12 @@
+package Default_Initial_Condition_Pack is
+   type T;
+   type T is private
+     with Default_Initial_Condition => Is_OK (T);
+
+   function Is_OK (Val : T) return Boolean;
+
+   DIC_Called : Boolean := False;
+
+private
+   type T is null record;
+end Default_Initial_Condition_Pack;