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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-04 Hristian Kirtchev <kirtc...@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.
--- gcc/ada/sem_util.adb
+++ 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);
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;