From c0471c61e1f3bcd86e819f2e6b5e054f80572a41 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 26 Jul 2021 15:26:28 -0400 Subject: [PATCH] [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. --- gcc/ada/contracts.adb | 6 +++--- gcc/ada/einfo-utils.adb | 4 ++-- gcc/ada/einfo-utils.ads | 2 +- gcc/ada/err_vars.ads | 17 +++++++++------ gcc/ada/errout.adb | 20 ++++------------- gcc/ada/erroutc.adb | 48 +++++++++++------------------------------ gcc/ada/exp_ch7.adb | 8 +++---- gcc/ada/exp_ch9.adb | 10 ++++----- gcc/ada/exp_disp.adb | 2 +- gcc/ada/exp_prag.adb | 12 +++++------ gcc/ada/exp_smem.adb | 2 +- gcc/ada/exp_util.adb | 4 ++-- gcc/ada/freeze.adb | 12 +++++------ gcc/ada/sem_aggr.adb | 2 +- gcc/ada/sem_attr.adb | 2 +- gcc/ada/sem_ch8.adb | 11 +++------- gcc/ada/sem_prag.ads | 2 +- gcc/ada/sem_util.adb | 2 +- gcc/ada/sem_util.ads | 2 +- 19 files changed, 65 insertions(+), 103 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index e37e092898f..705f197148c 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 cbd957bd9b9..4e5f43436f4 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 4eca35e1e5f..8046722442b 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 366df629d74..819d1ad9ad3 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 99c7f9a10b1..05a826682e0 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 a2cd3c3c7e0..9e67b929cb7 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 8d08ff12ed5..71cad989dc1 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 427b4301514..dec41eed2f8 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 bac64928c57..cfe6279aaf2 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 43ecdcdd333..55842f70f57 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 45db4870eea..216065f5be9 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 59c87637c67..807afb2c580 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 51671419b44..5b7607d051d 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 9ad96296dd4..23d5ba22615 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 f631e948a3e..d954d46aaad 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 a9f0f13e1e2..70ad21ccc24 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 e1664811f50..3d7b00ca557 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 c16a4b80e21..4a98b8bf64e 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 7c89585137e..79db0b47c14 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).