[Ada] Fix conformance errors and erroneous code

gcc/ada/

	* contracts.adb, einfo-utils.adb, einfo-utils.ads, exp_ch7.adb,
	exp_ch9.adb, exp_disp.adb, exp_prag.adb, exp_smem.adb,
	exp_util.adb, freeze.adb, sem_aggr.adb, sem_attr.adb,
	sem_ch8.adb, sem_prag.ads, sem_util.adb, sem_util.ads: Fix
	conformance errors.
	* errout.adb, erroutc.adb: Remove pragmas Suppress.
	* err_vars.ads: Initialize variables that were previously being
	read uninitialized.

19 files changed, 65 insertions, 103 deletions

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index e37e092..705f197 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -3440,7 +3440,7 @@ package body Contracts is
    -- Get_Postcond_Enabled --
    --------------------------
 
-   function Get_Postcond_Enabled (Subp : Entity_Id) return Node_Id is
+   function Get_Postcond_Enabled (Subp : Entity_Id) return Entity_Id is
       Decl : Node_Id;
    begin
       Decl :=
@@ -3465,7 +3465,7 @@ package body Contracts is
    ------------------------------------
 
    function Get_Result_Object_For_Postcond
-     (Subp : Entity_Id) return Node_Id
+     (Subp : Entity_Id) return Entity_Id
    is
       Decl : Node_Id;
    begin
@@ -3490,7 +3490,7 @@ package body Contracts is
    -- Get_Return_Success_For_Postcond --
    -------------------------------------
 
-   function Get_Return_Success_For_Postcond (Subp : Entity_Id) return Node_Id
+   function Get_Return_Success_For_Postcond (Subp : Entity_Id) return Entity_Id
    is
       Decl : Node_Id;
    begin
diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index cbd957b..4e5f434 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -701,7 +701,7 @@ package body Einfo.Utils is
    -- Entry_Index_Type --
    ----------------------
 
-   function Entry_Index_Type (Id : E) return N is
+   function Entry_Index_Type (Id : E) return E is
    begin
       pragma Assert (Ekind (Id) = E_Entry_Family);
       return Etype (Discrete_Subtype_Definition (Parent (Id)));
@@ -1745,7 +1745,7 @@ package body Einfo.Utils is
    -- Link_Entities --
    -------------------
 
-   procedure Link_Entities (First : Entity_Id; Second : Node_Id) is
+   procedure Link_Entities (First, Second : Entity_Id) is
    begin
       if Present (Second) then
          Set_Prev_Entity (Second, First);  --  First <-- Second
diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads
index 4eca35e..8046722 100644
--- a/gcc/ada/einfo-utils.ads
+++ b/gcc/ada/einfo-utils.ads
@@ -625,7 +625,7 @@ package Einfo.Utils is
 
    --  WARNING: There is a matching C declaration of this subprogram in fe.h
 
-   procedure Link_Entities (First : Entity_Id; Second : Entity_Id);
+   procedure Link_Entities (First, Second : Entity_Id);
    --  Link entities First and Second in one entity chain.
    --
    --  NOTE: No updates are done to the First_Entity and Last_Entity fields
diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads
index 366df62..819d1ad 100644
--- a/gcc/ada/err_vars.ads
+++ b/gcc/ada/err_vars.ads
@@ -105,12 +105,15 @@ package Err_Vars is
    --  of the following global variables to appropriate values before making a
    --  call to one of the error message routines with a string containing the
    --  insertion character to get the value inserted in an appropriate format.
+   --
+   --  Some of these are initialized below, because they are read before being
+   --  set by clients.
 
    Error_Msg_Col : Column_Number;
    --  Column for @ insertion character in message
 
    Error_Msg_Uint_1 : Uint;
-   Error_Msg_Uint_2 : Uint;
+   Error_Msg_Uint_2 : Uint := No_Uint;
    --  Uint values for ^ insertion characters in message
 
    --  WARNING: There is a matching C declaration of these variables in fe.h
@@ -119,21 +122,21 @@ package Err_Vars is
    --  Source location for # insertion character in message
 
    Error_Msg_Name_1 : Name_Id;
-   Error_Msg_Name_2 : Name_Id;
-   Error_Msg_Name_3 : Name_Id;
+   Error_Msg_Name_2 : Name_Id := No_Name;
+   Error_Msg_Name_3 : Name_Id := No_Name;
    --  Name_Id values for % insertion characters in message
 
    Error_Msg_File_1 : File_Name_Type;
-   Error_Msg_File_2 : File_Name_Type;
-   Error_Msg_File_3 : File_Name_Type;
+   Error_Msg_File_2 : File_Name_Type := No_File;
+   Error_Msg_File_3 : File_Name_Type := No_File;
    --  File_Name_Type values for { insertion characters in message
 
    Error_Msg_Unit_1 : Unit_Name_Type;
-   Error_Msg_Unit_2 : Unit_Name_Type;
+   Error_Msg_Unit_2 : Unit_Name_Type := No_Unit_Name;
    --  Unit_Name_Type values for $ insertion characters in message
 
    Error_Msg_Node_1 : Node_Id;
-   Error_Msg_Node_2 : Node_Id;
+   Error_Msg_Node_2 : Node_Id := Empty;
    --  Node_Id values for & insertion characters in message
 
    Error_Msg_Warn : Boolean;
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 99c7f9a..05a8266 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -3602,15 +3602,9 @@ package body Errout is
       end if;
 
       --  The following assignment ensures that a second ampersand insertion
-      --  character will correspond to the Error_Msg_Node_2 parameter. We
-      --  suppress possible validity checks in case operating in -gnatVa mode,
-      --  and Error_Msg_Node_2 is not needed and has not been set.
+      --  character will correspond to the Error_Msg_Node_2 parameter.
 
-      declare
-         pragma Suppress (Range_Check);
-      begin
-         Error_Msg_Node_1 := Error_Msg_Node_2;
-      end;
+      Error_Msg_Node_1 := Error_Msg_Node_2;
    end Set_Msg_Insertion_Node;
 
    --------------------------------------
@@ -3790,15 +3784,9 @@ package body Errout is
       end if;
 
       --  The following assignment ensures that a second percent insertion
-      --  character will correspond to the Error_Msg_Unit_2 parameter. We
-      --  suppress possible validity checks in case operating in -gnatVa mode,
-      --  and Error_Msg_Unit_2 is not needed and has not been set.
+      --  character will correspond to the Error_Msg_Unit_2 parameter.
 
-      declare
-         pragma Suppress (Range_Check);
-      begin
-         Error_Msg_Unit_1 := Error_Msg_Unit_2;
-      end;
+      Error_Msg_Unit_1 := Error_Msg_Unit_2;
    end Set_Msg_Insertion_Unit_Name;
 
    ------------------
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index a2cd3c3..9e67b92 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -1119,17 +1119,11 @@ package body Erroutc is
       end if;
 
       --  The following assignments ensure that the second and third {
-      --  insertion characters will correspond to the Error_Msg_File_2 and
-      --  Error_Msg_File_3 values and We suppress possible validity checks in
-      --  case operating in -gnatVa mode, and Error_Msg_File_2 or
-      --  Error_Msg_File_3 is not needed and has not been set.
+      --  insertion characters will correspond to the Error_Msg_File_2
+      --  and Error_Msg_File_3 values.
 
-      declare
-         pragma Suppress (Range_Check);
-      begin
-         Error_Msg_File_1 := Error_Msg_File_2;
-         Error_Msg_File_2 := Error_Msg_File_3;
-      end;
+      Error_Msg_File_1 := Error_Msg_File_2;
+      Error_Msg_File_2 := Error_Msg_File_3;
    end Set_Msg_Insertion_File_Name;
 
    -----------------------------------
@@ -1299,16 +1293,10 @@ package body Erroutc is
 
       --  The following assignments ensure that the second and third percent
       --  insertion characters will correspond to the Error_Msg_Name_2 and
-      --  Error_Msg_Name_3 as required. We suppress possible validity checks in
-      --  case operating in -gnatVa mode, and Error_Msg_Name_1/2 is not needed
-      --  and has not been set.
+      --  Error_Msg_Name_3 as required.
 
-      declare
-         pragma Suppress (Range_Check);
-      begin
-         Error_Msg_Name_1 := Error_Msg_Name_2;
-         Error_Msg_Name_2 := Error_Msg_Name_3;
-      end;
+      Error_Msg_Name_1 := Error_Msg_Name_2;
+      Error_Msg_Name_2 := Error_Msg_Name_3;
    end Set_Msg_Insertion_Name;
 
    ------------------------------------
@@ -1334,16 +1322,10 @@ package body Erroutc is
 
       --  The following assignments ensure that the second and third % or %%
       --  insertion characters will correspond to the Error_Msg_Name_2 and
-      --  Error_Msg_Name_3 values and We suppress possible validity checks in
-      --  case operating in -gnatVa mode, and Error_Msg_Name_2 or
-      --  Error_Msg_Name_3 is not needed and has not been set.
+      --  Error_Msg_Name_3 values.
 
-      declare
-         pragma Suppress (Range_Check);
-      begin
-         Error_Msg_Name_1 := Error_Msg_Name_2;
-         Error_Msg_Name_2 := Error_Msg_Name_3;
-      end;
+      Error_Msg_Name_1 := Error_Msg_Name_2;
+      Error_Msg_Name_2 := Error_Msg_Name_3;
    end Set_Msg_Insertion_Name_Literal;
 
    -------------------------------------
@@ -1427,15 +1409,9 @@ package body Erroutc is
       end loop;
 
       --  The following assignment ensures that a second caret insertion
-      --  character will correspond to the Error_Msg_Uint_2 parameter. We
-      --  suppress possible validity checks in case operating in -gnatVa mode,
-      --  and Error_Msg_Uint_2 is not needed and has not been set.
+      --  character will correspond to the Error_Msg_Uint_2 parameter.
 
-      declare
-         pragma Suppress (Range_Check);
-      begin
-         Error_Msg_Uint_1 := Error_Msg_Uint_2;
-      end;
+      Error_Msg_Uint_1 := Error_Msg_Uint_2;
    end Set_Msg_Insertion_Uint;
 
    -----------------
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 8d08ff1..71cad98 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -486,11 +486,11 @@ package body Exp_Ch7 is
    function Make_Deep_Proc
      (Prim  : Final_Primitives;
       Typ   : Entity_Id;
-      Stmts : List_Id) return Node_Id;
+      Stmts : List_Id) return Entity_Id;
    --  This function generates the tree for Deep_Initialize, Deep_Adjust or
-   --  Deep_Finalize procedures according to the first parameter, these
-   --  procedures operate on the type Typ. The Stmts parameter gives the body
-   --  of the procedure.
+   --  Deep_Finalize procedures according to the first parameter. These
+   --  procedures operate on the type Typ. The Stmts parameter gives the
+   --  body of the procedure.
 
    function Make_Deep_Array_Body
      (Prim : Final_Primitives;
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 427b430..dec41ee 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -145,7 +145,7 @@ package body Exp_Ch9 is
 
    function Build_Corresponding_Record
      (N    : Node_Id;
-      Ctyp : Node_Id;
+      Ctyp : Entity_Id;
       Loc  : Source_Ptr) return Node_Id;
    --  Common to tasks and protected types. Copy discriminant specifications,
    --  build record declaration. N is the type declaration, Ctyp is the
@@ -1583,9 +1583,9 @@ package body Exp_Ch9 is
    --------------------------------
 
    function Build_Corresponding_Record
-    (N    : Node_Id;
-     Ctyp : Entity_Id;
-     Loc  : Source_Ptr) return Node_Id
+     (N    : Node_Id;
+      Ctyp : Entity_Id;
+      Loc  : Source_Ptr) return Node_Id
    is
       Rec_Ent  : constant Entity_Id :=
                    Make_Defining_Identifier
@@ -14867,7 +14867,7 @@ package body Exp_Ch9 is
       Actuals : List_Id;
       Formals : List_Id;
       Decls   : List_Id;
-      Stmts   : List_Id) return Node_Id
+      Stmts   : List_Id) return Entity_Id
    is
       Actual    : Entity_Id;
       Expr      : Node_Id := Empty;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index bac6492..cfe6279 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -348,7 +348,7 @@ package body Exp_Disp is
    -- Build_Static_Dispatch_Tables --
    ----------------------------------
 
-   procedure Build_Static_Dispatch_Tables (N : Entity_Id) is
+   procedure Build_Static_Dispatch_Tables (N : Node_Id) is
       Target_List : List_Id;
 
       procedure Build_Dispatch_Tables (List : List_Id);
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 43ecdcd..55842f7 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -752,10 +752,10 @@ package body Exp_Prag is
       --  value of which is Init_Val if present or null if not.
 
       function Build_Simple_Declaration_With_Default
-         (Decl_Id     : Entity_Id;
-          Init_Val    : Entity_Id;
-          Typ         : Entity_Id;
-          Default_Val : Entity_Id) return Node_Id;
+        (Decl_Id     : Entity_Id;
+         Init_Val    : Node_Id;
+         Typ         : Node_Id;
+         Default_Val : Node_Id) return Node_Id;
       --  Build a declaration the Defining_Identifier of which is Decl_Id, the
       --  Object_Definition of which is Typ, the value of which is Init_Val if
       --  present or Default otherwise.
@@ -983,7 +983,7 @@ package body Exp_Prag is
       function Build_Simple_Declaration_With_Default
         (Decl_Id     : Entity_Id;
          Init_Val    : Node_Id;
-         Typ         : Entity_Id;
+         Typ         : Node_Id;
          Default_Val : Node_Id) return Node_Id
       is
          Value : Node_Id := Init_Val;
@@ -2862,7 +2862,7 @@ package body Exp_Prag is
 
    procedure Expand_Pragma_Subprogram_Variant
      (Prag       : Node_Id;
-      Subp_Id    : Node_Id;
+      Subp_Id    : Entity_Id;
       Body_Decls : List_Id)
    is
       Curr_Decls : List_Id;
diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb
index 45db487..216065f5 100644
--- a/gcc/ada/exp_smem.adb
+++ b/gcc/ada/exp_smem.adb
@@ -86,7 +86,7 @@ package body Exp_Smem is
 
    function Build_Shared_Var_Proc_Call
      (Loc : Source_Ptr;
-      E   : Node_Id;
+      E   : Entity_Id;
       N   : Name_Id) return Node_Id;
    --  Build a call to support procedure N for shared object E (provided by the
    --  instance of System.Shared_Storage.Shared_Var_Procs associated to E).
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 59c8763..807afb2 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -4914,7 +4914,7 @@ package body Exp_Util is
    -- Convert_To_Actual_Subtype --
    -------------------------------
 
-   procedure Convert_To_Actual_Subtype (Exp : Entity_Id) is
+   procedure Convert_To_Actual_Subtype (Exp : Node_Id) is
       Act_ST : Entity_Id;
 
    begin
@@ -7048,7 +7048,7 @@ package body Exp_Util is
    -- Get_Index_Subtype --
    -----------------------
 
-   function Get_Index_Subtype (N : Node_Id) return Node_Id is
+   function Get_Index_Subtype (N : Node_Id) return Entity_Id is
       P_Type : Entity_Id := Etype (Prefix (N));
       Indx   : Node_Id;
       J      : Int;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 5167141..5b7607d 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -284,11 +284,11 @@ package body Freeze is
    --  Full_View or Corresponding_Record_Type.
 
    procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Node_Id);
-   --  Expr is the expression for an address clause for entity Nam whose type
-   --  is Typ. If Typ has a default initialization, and there is no explicit
-   --  initialization in the source declaration, check whether the address
-   --  clause might cause overlaying of an entity, and emit a warning on the
-   --  side effect that the initialization will cause.
+   --  Expr is the expression for an address clause for the entity denoted by
+   --  Nam whose type is Typ. If Typ has a default initialization, and there is
+   --  no explicit initialization in the source declaration, check whether the
+   --  address clause might cause overlaying of an entity, and emit a warning
+   --  on the side effect that the initialization will cause.
 
    -------------------------------
    -- Adjust_Esize_For_Alignment --
@@ -10081,7 +10081,7 @@ package body Freeze is
    -- Warn_Overlay --
    ------------------
 
-   procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Entity_Id) is
+   procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Node_Id) is
       Ent : constant Entity_Id := Entity (Nam);
       --  The object to which the address clause applies
 
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 9ad9629..23d5ba2 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -365,7 +365,7 @@ package body Sem_Aggr is
    --  to the expansion phase. As an optimization, if the discrete choice
    --  specifies a single value we do not delay resolution.
 
-   function Array_Aggr_Subtype (N : Node_Id; Typ : Node_Id) return Entity_Id;
+   function Array_Aggr_Subtype (N : Node_Id; Typ : Entity_Id) return Entity_Id;
    --  This routine returns the type or subtype of an array aggregate.
    --
    --    N is the array aggregate node whose type we return.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index f631e94..d954d46 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -12469,7 +12469,7 @@ package body Sem_Attr is
    function Stream_Attribute_Available
      (Typ          : Entity_Id;
       Nam          : TSS_Name_Type;
-      Partial_View : Node_Id := Empty) return Boolean
+      Partial_View : Entity_Id := Empty) return Boolean
    is
       Etyp : Entity_Id := Typ;
 
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index a9f0f13..70ad21c 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -426,12 +426,10 @@ package body Sem_Ch8 is
    --  body at the point of freezing will not work. Subp is the subprogram
    --  for which N provides the Renaming_As_Body.
 
-   procedure Check_In_Previous_With_Clause
-     (N   : Node_Id;
-      Nam : Node_Id);
+   procedure Check_In_Previous_With_Clause (N, Nam : Node_Id);
    --  N is a use_package clause and Nam the package name, or N is a use_type
    --  clause and Nam is the prefix of the type name. In either case, verify
-   --  that the package is visible at that point in the context: either  it
+   --  that the package is visible at that point in the context: either it
    --  appears in a previous with_clause, or because it is a fully qualified
    --  name and the root ancestor appears in a previous with_clause.
 
@@ -4670,10 +4668,7 @@ package body Sem_Ch8 is
    -- Check_In_Previous_With_Clause --
    -----------------------------------
 
-   procedure Check_In_Previous_With_Clause
-     (N   : Node_Id;
-      Nam : Entity_Id)
-   is
+   procedure Check_In_Previous_With_Clause (N, Nam : Node_Id) is
       Pack : constant Entity_Id := Entity (Original_Node (Nam));
       Item : Node_Id;
       Par  : Node_Id;
diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index e166481..3d7b00c 100644
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -429,7 +429,7 @@ package Sem_Prag is
 
    function Get_Argument
      (Prag       : Node_Id;
-      Context_Id : Node_Id := Empty) return Node_Id;
+      Context_Id : Entity_Id := Empty) return Node_Id;
    --  Obtain the argument of pragma Prag depending on context and the nature
    --  of the pragma. The argument is extracted in the following manner:
    --
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c16a4b8..4a98b8b 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -24709,7 +24709,7 @@ package body Sem_Util is
       -- Visit_Node --
       ----------------
 
-      procedure Visit_Node (N : Node_Or_Entity_Id) is
+      procedure Visit_Node (N : Node_Id) is
       begin
          pragma Assert (Nkind (N) not in N_Entity);
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 7c89585..79db0b4 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -356,7 +356,7 @@ package Sem_Util is
    --  carries the name of the reference discriminant.
 
    function Build_Overriding_Spec
-     (Op  : Node_Id;
+     (Op  : Entity_Id;
       Typ : Entity_Id) return Node_Id;
    --  Build a subprogram specification for the wrapper of an inherited
    --  operation with a modified pre- or postcondition (See AI12-0113).