[Ada] Fix spurious -Wuninitialized warnings for small records

This change is aimed at getting rid of spurious -Wuninitialized warnings
issued for small records passed by copy and containing default values
for some of their components.

The source of the problem is that the _Init parameter of the
initialization routine is declared as an in/out parameter, so the
uninitialized object is passed by copy to it and this can be flagged by
-Wuninitialized.

That's why the mode of the parameter is changed to out, except for the
cases where information really needs to be passed in: unconstrained
array types, protected and task types.

For the following record type Rec!

 type Rec is record
    B : Boolean := True;
  end record;

the initialization routine must now be:

      procedure r__recIP (_init : out r__rec1) is
      begin
         _init.b := true;
         return;
      end r__recIP;

2018-10-09  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch3.adb (Is_Null_Statement_List): New predicate.
	(Build_Array_Init_Proc): Use it to find out whether the
	initialization procedure Is_Null_Init_Proc; if so, set
	Warnings_Off on the parameter.
	(Build_Init_Procedure): Likewise.
	(Init_Formals): Use an in/out first parameter only for
	unconstrained arrays and for records either containing or built
	for proteced types or task types; use an out parameter in all
	the other cases.
	* fe.h (Is_Init_Proc): Declare.
	* gcc-interface/decl.c (type_requires_init_of_formal): Do not
	return true for a discriminant in an unchecked union.
	(gnat_to_gnu_param): Do not create a PARM_DECL for the Out
	parameter of an initialization procedure.

From-SVN: r264984

4 files changed, 99 insertions, 28 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 924e8d6..3aa9a88 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,22 @@
 2018-10-09  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* exp_ch3.adb (Is_Null_Statement_List): New predicate.
+	(Build_Array_Init_Proc): Use it to find out whether the
+	initialization procedure Is_Null_Init_Proc; if so, set
+	Warnings_Off on the parameter.
+	(Build_Init_Procedure): Likewise.
+	(Init_Formals): Use an in/out first parameter only for
+	unconstrained arrays and for records either containing or built
+	for proteced types or task types; use an out parameter in all
+	the other cases.
+	* fe.h (Is_Init_Proc): Declare.
+	* gcc-interface/decl.c (type_requires_init_of_formal): Do not
+	return true for a discriminant in an unchecked union.
+	(gnat_to_gnu_param): Do not create a PARM_DECL for the Out
+	parameter of an initialization procedure.
+
+2018-10-09  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Constant>: If
 	this is not a definition, retrieve the expression in all cases
 	even if we are just annotating types.
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 9281896..e116cda 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -202,6 +202,11 @@ package body Exp_Ch3 is
    --  Check if E is defined in the RTL (in a child of Ada or System). Used
    --  to avoid to bring in the overhead of _Input, _Output for tagged types.
 
+   function Is_Null_Statement_List (Stmts : List_Id) return Boolean;
+   --  Returns true if Stmts is made of null statements only, possibly wrapped
+   --  in a case statement, recursively. This latter pattern may occur for the
+   --  initialization procedure of an unchecked union.
+
    function Is_User_Defined_Equality (Prim : Node_Id) return Boolean;
    --  Returns true if Prim is a user defined equality function
 
@@ -529,6 +534,7 @@ package body Exp_Ch3 is
       Has_Default_Init : Boolean;
       Index_List       : List_Id;
       Loc              : Source_Ptr;
+      Parameters       : List_Id;
       Proc_Id          : Entity_Id;
 
       function Init_Component return List_Id;
@@ -722,13 +728,14 @@ package body Exp_Ch3 is
          end if;
 
          Body_Stmts := Init_One_Dimension (1);
+         Parameters := Init_Formals (A_Type);
 
          Discard_Node (
            Make_Subprogram_Body (Loc,
              Specification =>
                Make_Procedure_Specification (Loc,
                  Defining_Unit_Name => Proc_Id,
-                 Parameter_Specifications => Init_Formals (A_Type)),
+                 Parameter_Specifications => Parameters),
              Declarations => New_List,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
@@ -753,18 +760,14 @@ package body Exp_Ch3 is
          --  where we have to generate a null procedure in case it is called
          --  by a client with Initialize_Scalars set). Such procedures have
          --  to be generated, but do not have to be called, so we mark them
-         --  as null to suppress the call.
+         --  as null to suppress the call. Kill also warnings for the _Init
+         --  out parameter, which is left entirely uninitialized.
 
          Set_Init_Proc (A_Type, Proc_Id);
 
-         if List_Length (Body_Stmts) = 1
-
-           --  We must skip SCIL nodes because they may have been added to this
-           --  list by Insert_Actions.
-
-           and then Nkind (First_Non_SCIL_Node (Body_Stmts)) = N_Null_Statement
-         then
+         if Is_Null_Statement_List (Body_Stmts) then
             Set_Is_Null_Init_Proc (Proc_Id);
+            Set_Warnings_Off (Defining_Identifier (First (Parameters)));
 
          else
             --  Try to build a static aggregate to statically initialize
@@ -2803,18 +2806,14 @@ package body Exp_Ch3 is
          --  where we have to generate a null procedure in case it is called
          --  by a client with Initialize_Scalars set). Such procedures have
          --  to be generated, but do not have to be called, so we mark them
-         --  as null to suppress the call.
+         --  as null to suppress the call. Kill also warnings for the _Init
+         --  out parameter, which is left entirely uninitialized.
 
          Set_Init_Proc (Rec_Type, Proc_Id);
 
-         if List_Length (Body_Stmts) = 1
-
-           --  We must skip SCIL nodes because they may have been added to this
-           --  list by Insert_Actions.
-
-           and then Nkind (First_Non_SCIL_Node (Body_Stmts)) = N_Null_Statement
-         then
+         if Is_Null_Statement_List (Body_Stmts) then
             Set_Is_Null_Init_Proc (Proc_Id);
+            Set_Warnings_Off (Defining_Identifier (First (Parameters)));
          end if;
       end Build_Init_Procedure;
 
@@ -8612,19 +8611,30 @@ package body Exp_Ch3 is
    ------------------
 
    function Init_Formals (Typ : Entity_Id) return List_Id is
+      Unc_Arr : constant Boolean :=
+        Is_Array_Type (Typ) and then not Is_Constrained (Typ);
+      With_Prot  : constant Boolean :=
+        Has_Protected (Typ)
+          or else (Is_Record_Type (Typ)
+                     and then Is_Protected_Record_Type (Typ));
+      With_Task  : constant Boolean :=
+        Has_Task (Typ)
+          or else (Is_Record_Type (Typ)
+                     and then Is_Task_Record_Type (Typ));
       Loc     : constant Source_Ptr := Sloc (Typ);
       Formals : List_Id;
 
    begin
-      --  First parameter is always _Init : in out typ. Note that we need this
-      --  to be in/out because in the case of the task record value, there
-      --  are default record fields (_Priority, _Size, -Task_Info) that may
-      --  be referenced in the generated initialization routine.
+      --  The first parameter is always _Init : [in] out Typ. Note that we need
+      --  it to be in/out in the case of an unconstrained array, because of the
+      --  need to have the bounds, and in the case of protected or task record
+      --  value, because there are default record fields that may be referenced
+      --  in the generated initialization routine.
 
       Formals := New_List (
         Make_Parameter_Specification (Loc,
           Defining_Identifier => Make_Defining_Identifier (Loc, Name_uInit),
-          In_Present          => True,
+          In_Present          => Unc_Arr or else With_Prot or else With_Task,
           Out_Present         => True,
           Parameter_Type      => New_Occurrence_Of (Typ, Loc)));
 
@@ -8632,9 +8642,7 @@ package body Exp_Ch3 is
       --  formals, _Master : Master_Id and _Chain : in out Activation_Chain
       --  We also add these parameters for the task record type case.
 
-      if Has_Task (Typ)
-        or else (Is_Record_Type (Typ) and then Is_Task_Record_Type (Typ))
-      then
+      if With_Task then
          Append_To (Formals,
            Make_Parameter_Specification (Loc,
              Defining_Identifier =>
@@ -9022,6 +9030,43 @@ package body Exp_Ch3 is
       end loop;
    end Init_Secondary_Tags;
 
+   ----------------------------
+   -- Is_Null_Statement_List --
+   ----------------------------
+
+   function Is_Null_Statement_List (Stmts : List_Id) return Boolean is
+      Stmt : Node_Id;
+
+   begin
+      --  We must skip SCIL nodes because they may have been added to the
+      --  list by Insert_Actions.
+
+      Stmt := First_Non_SCIL_Node (Stmts);
+      while Present (Stmt) loop
+         if Nkind (Stmt) = N_Case_Statement then
+            declare
+               Alt : Node_Id;
+            begin
+               Alt := First (Alternatives (Stmt));
+               while Present (Alt) loop
+                  if not Is_Null_Statement_List (Statements (Alt)) then
+                     return False;
+                  end if;
+
+                  Next (Alt);
+               end loop;
+            end;
+
+         elsif Nkind (Stmt) /= N_Null_Statement then
+            return False;
+         end if;
+
+         Stmt := Next_Non_SCIL_Node (Stmt);
+      end loop;
+
+      return True;
+   end Is_Null_Statement_List;
+
    ------------------------------
    -- Is_User_Defined_Equality --
    ------------------------------
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index 7c32044..b0ccbdc 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -156,6 +156,12 @@ extern void Setup_Asm_Outputs		(Node_Id);
 extern void Get_Encoded_Name	(Entity_Id);
 extern void Get_External_Name	(Entity_Id, Boolean, String_Pointer);
 
+/* exp_tss: */
+
+#define Is_Init_Proc exp_tss__is_init_proc
+
+extern Boolean Is_Init_Proc		(Entity_Id);
+
 /* exp_util: */
 
 #define Is_Fully_Repped_Tagged_Type exp_util__is_fully_repped_tagged_type
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index a0d2cbe..c658aac 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -5153,7 +5153,7 @@ type_requires_init_of_formal (Entity_Id type)
 	 Present (field);
 	 field = Next_Entity (field))
       {
-	if (Ekind (field) == E_Discriminant)
+	if (Ekind (field) == E_Discriminant && !Is_Unchecked_Union (type))
 	  return true;
 
 	if (Ekind (field) == E_Component
@@ -5334,11 +5334,14 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first,
      type doesn't require the initialization of formals, we don't make a
      PARM_DECL for it.  Instead, it will be a VAR_DECL created when we
      process the procedure, so just return its type here.  Likewise for
-     the special parameter of a valued procedure, never pass it in.  */
+     the _Init parameter of an initialization procedure or the special
+     parameter of a valued procedure, never pass them in.  */
   if (Ekind (gnat_param) == E_Out_Parameter
       && !by_ref
       && !by_component_ptr
-      && (!type_requires_init_of_formal (Etype (gnat_param)) || by_return))
+      && (!type_requires_init_of_formal (Etype (gnat_param))
+	  || Is_Init_Proc (gnat_subprog)
+	  || by_return))
     return gnu_param_type;
 
   gnu_param = create_param_decl (gnu_param_name, gnu_param_type);