[Ada] Missing actual for generated initialization procedure

This patch fixes an issue whereby the use of an allocator with a
composite type containing null-excluding components may lead to a
compile time error due to incorrect code generation.

2019-07-04  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* exp_ch3.adb (Build_Initialization_Call): Fixup
	*_skip_null_excluding_check argument to handle new default.
	(Init_Formals): Make *_skip_null_excluding_check formal default
	to False
	* exp_ch4.adb (Expand_N_Allocator): Add comment to note heavy
	code duplication

gcc/testsuite/

	* gnat.dg/allocator.adb: New testcase.

From-SVN: r273061

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f11f78b..b5e9bd6 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2019-07-04  Justin Squirek  <squirek@adacore.com>
+
+       * exp_ch3.adb (Build_Initialization_Call): Fixup
+       *_skip_null_excluding_check argument to handle new default.
+       (Init_Formals): Make *_skip_null_excluding_check formal default
+       to False
+       * exp_ch4.adb (Expand_N_Allocator): Add comment to note heavy
+       code duplication
+
 2019-07-04  Bob Duff  <duff@adacore.com>
 
        * sem_ch3.adb (Access_Definition): Do not create a master unless

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 753c5fb..49fcfd7 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -1555,23 +1555,19 @@ package body Exp_Ch3 is
 
       --  Handle the optionally generated formal *_skip_null_excluding_checks
 
-      if Needs_Conditional_Null_Excluding_Check (Full_Init_Type) then
-
-         --  Look at the associated node for the object we are referencing
-         --  and verify that we are expanding a call to an Init_Proc for an
-         --  internally generated object declaration before passing True and
-         --  skipping the relevant checks.
-
-         if Nkind (Id_Ref) in N_Has_Entity
-           and then Comes_From_Source (Associated_Node (Id_Ref))
-         then
-            Append_To (Args, New_Occurrence_Of (Standard_True, Loc));
-
-         --  Otherwise, we pass False to perform null-excluding checks
-
-         else
-            Append_To (Args, New_Occurrence_Of (Standard_False, Loc));
-         end if;
+      --  Look at the associated node for the object we are referencing and
+      --  verify that we are expanding a call to an Init_Proc for an internally
+      --  generated object declaration before passing True and skipping the
+      --  relevant checks.
+
+      if Needs_Conditional_Null_Excluding_Check (Full_Init_Type)
+        and then Nkind (Id_Ref) in N_Has_Entity
+        and then (Comes_From_Source (Id_Ref)
+                   or else (Present (Associated_Node (Id_Ref))
+                             and then Comes_From_Source
+                                        (Associated_Node (Id_Ref))))
+      then
+         Append_To (Args, New_Occurrence_Of (Standard_True, Loc));
       end if;
 
       --  Add discriminant values if discriminants are present
@@ -8695,6 +8691,7 @@ package body Exp_Ch3 is
                Make_Defining_Identifier (Loc,
                  New_External_Name (Chars
                    (Component_Type (Typ)), "_skip_null_excluding_check")),
+             Expression          => New_Occurrence_Of (Standard_False, Loc),
              In_Present          => True,
              Parameter_Type      =>
                New_Occurrence_Of (Standard_Boolean, Loc)));

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7ba4283..7a757e4 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4751,6 +4751,9 @@ package body Exp_Ch4 is
 
          --  Case of initialization procedure present, must be called
 
+         --  NOTE: There is a *huge* amount of code duplication here from
+         --  Build_Initialization_Call. We should probably refactor???
+
          else
             Check_Restriction (No_Default_Initialization, N);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2b1a479..c4b0046 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-04  Justin Squirek  <squirek@adacore.com>
+
+       * gnat.dg/allocator.adb: New testcase.
+
 2019-07-04  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * gnat.dg/default_initial_condition.adb,

diff --git a/gcc/testsuite/gnat.dg/allocator.adb b/gcc/testsuite/gnat.dg/allocator.adb
new file mode 100644 (file)
index 0000000..c3840aa
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/allocator.adb
@@ -0,0 +1,11 @@
+--  { dg-do compile }
+
+procedure Allocator is
+   type Object_Type      is not null access all Integer;
+   type Object_Array     is array (Positive range <>) of Object_Type;
+   type Object_Array_Ptr is access Object_Array;
+   type Data_Ptr         is access Object_Array_Ptr;
+   Copy : Data_Ptr := new Object_Array_Ptr;
+begin
+   Copy.all := new Object_Array (1..2);
+end;