From 5612989e5b06ce72f7c50cd6244c4c98ac4d3c76 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Thu, 9 Nov 2017 12:46:58 +0000 Subject: [PATCH] [multiple changes] 2017-11-09 Javier Miranda * rtsfind.ads (RE_Id, RE_Unit_Table): Add RE_HT_Link. * exp_disp.adb (Make_DT): Initialize the HT_Link field of the TSD only if available. 2017-11-09 Bob Duff * exp_ch4.adb, exp_ch9.adb, exp_prag.adb, par-ch3.adb, sem_aggr.adb, sem_ch12.adb, sem_ch13.adb, sem_ch4.adb, sem_disp.adb, sem_prag.adb, sem_res.adb, sem_util.adb: Get rid of warnings about uninitialized variables. From-SVN: r254577 --- gcc/ada/ChangeLog | 13 +++++++ gcc/ada/exp_ch4.adb | 2 + gcc/ada/exp_ch9.adb | 2 +- gcc/ada/exp_disp.adb | 3 +- gcc/ada/exp_prag.adb | 2 +- gcc/ada/par-ch3.adb | 19 +-------- gcc/ada/rtsfind.ads | 2 + gcc/ada/sem_aggr.adb | 6 ++- gcc/ada/sem_ch12.adb | 4 +- gcc/ada/sem_ch13.adb | 91 ++++++++++++++++++++++++-------------------- gcc/ada/sem_ch4.adb | 14 +++---- gcc/ada/sem_disp.adb | 2 +- gcc/ada/sem_prag.adb | 51 ++++++++++++++----------- gcc/ada/sem_res.adb | 4 +- gcc/ada/sem_util.adb | 7 ++-- 15 files changed, 120 insertions(+), 102 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3fd6b40fc0e..d2a48f73c0a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2017-11-09 Javier Miranda + + * rtsfind.ads (RE_Id, RE_Unit_Table): Add RE_HT_Link. + * exp_disp.adb (Make_DT): Initialize the HT_Link field of the TSD only + if available. + +2017-11-09 Bob Duff + + * exp_ch4.adb, exp_ch9.adb, exp_prag.adb, par-ch3.adb, sem_aggr.adb, + sem_ch12.adb, sem_ch13.adb, sem_ch4.adb, sem_disp.adb, sem_prag.adb, + sem_res.adb, sem_util.adb: Get rid of warnings about uninitialized + variables. + 2017-11-09 Yannick Moy * exp_disp.adb (Make_DT): Default initialize Ifaces_List and diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index a2aa25b8d59..88303c66861 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10749,6 +10749,8 @@ package body Exp_Ch4 is if Present (Stored) then Elmt := First_Elmt (Stored); + else + Elmt := No_Elmt; -- init to avoid warning end if; Cons := New_List; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 2afd652ba4b..d94a72ffeb8 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -12355,7 +12355,7 @@ package body Exp_Ch9 is Call : Node_Id; Call_Ent : Entity_Id; Conc_Typ_Stmts : List_Id; - Concval : Node_Id; + Concval : Node_Id := Empty; -- init to avoid warning D_Alt : constant Node_Id := Delay_Alternative (N); D_Conv : Node_Id; D_Disc : Node_Id; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index fd050ca780c..8f82c7de72b 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -5390,7 +5390,8 @@ package body Exp_Disp is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (HT_Link, Loc), Attribute_Name => Name_Address))); - else + + elsif RTE_Record_Component_Available (RE_HT_Link) then Append_To (TSD_Aggr_List, Unchecked_Convert_To (RTE (RE_Tag_Ptr), New_Occurrence_Of (RTE (RE_Null_Address), Loc))); diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index dfed6af66a7..a92db56b525 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -1090,7 +1090,7 @@ package body Exp_Prag is Conseq_Checks : Node_Id := Empty; Count : Entity_Id; Count_Decl : Node_Id; - Error_Decls : List_Id; + Error_Decls : List_Id := No_List; -- init to avoid warning Flag : Entity_Id; Flag_Decl : Node_Id; If_Stmt : Node_Id; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 54dd5621fd8..ddbf716ea6d 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -4314,6 +4314,8 @@ package body Ch3 is Scan_State : Saved_Scan_State; begin + Done := False; + if Style_Check then Style.Check_Indentation; end if; @@ -4326,7 +4328,6 @@ package body Ch3 is => Check_Bad_Layout; Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls); - Done := False; when Tok_For => Check_Bad_Layout; @@ -4350,12 +4351,10 @@ package body Ch3 is Restore_Scan_State (Scan_State); Append (P_Representation_Clause, Decls); - Done := False; when Tok_Generic => Check_Bad_Layout; Append (P_Generic, Decls); - Done := False; when Tok_Identifier => Check_Bad_Layout; @@ -4370,7 +4369,6 @@ package body Ch3 is Token := Tok_Overriding; Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls); - Done := False; -- Normal case, no overriding, or overriding followed by colon @@ -4381,38 +4379,31 @@ package body Ch3 is when Tok_Package => Check_Bad_Layout; Append (P_Package (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls); - Done := False; when Tok_Pragma => Append (P_Pragma, Decls); - Done := False; when Tok_Protected => Check_Bad_Layout; Scan; -- past PROTECTED Append (P_Protected, Decls); - Done := False; when Tok_Subtype => Check_Bad_Layout; Append (P_Subtype_Declaration, Decls); - Done := False; when Tok_Task => Check_Bad_Layout; Scan; -- past TASK Append (P_Task, Decls); - Done := False; when Tok_Type => Check_Bad_Layout; Append (P_Type_Declaration, Decls); - Done := False; when Tok_Use => Check_Bad_Layout; P_Use_Clause (Decls); - Done := False; when Tok_With => Check_Bad_Layout; @@ -4439,8 +4430,6 @@ package body Ch3 is -- a declarative list. After discarding the misplaced aspects -- we can continue the scan. - Done := False; - declare Dummy_Node : constant Node_Id := New_Node (N_Package_Specification, Token_Ptr); @@ -4533,8 +4522,6 @@ package body Ch3 is End_Statements (Handled_Statement_Sequence (Body_Node)); end; - Done := False; - else Done := True; end if; @@ -4556,7 +4543,6 @@ package body Ch3 is -- After discarding the misplaced aspects we can continue the -- scan. - Done := False; else Restore_Scan_State (Scan_State); -- to END Done := True; @@ -4671,7 +4657,6 @@ package body Ch3 is exception when Error_Resync => Resync_Past_Semicolon; - Done := False; end P_Declarative_Items; ---------------------------------- diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index c4d7d3c80c6..57b8897f2da 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -631,6 +631,7 @@ package Rtsfind is RE_Get_Offset_Index, -- Ada.Tags RE_Get_Prim_Op_Kind, -- Ada.Tags RE_Get_Tagged_Kind, -- Ada.Tags + RE_HT_Link, -- Ada.Tags RE_Idepth, -- Ada.Tags RE_Interfaces_Array, -- Ada.Tags RE_Interfaces_Table, -- Ada.Tags @@ -1866,6 +1867,7 @@ package Rtsfind is RE_Get_Offset_Index => Ada_Tags, RE_Get_Prim_Op_Kind => Ada_Tags, RE_Get_Tagged_Kind => Ada_Tags, + RE_HT_Link => Ada_Tags, RE_Idepth => Ada_Tags, RE_Interfaces_Array => Ada_Tags, RE_Interfaces_Table => Ada_Tags, diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 72bd856e933..7d6ae41c49e 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2882,7 +2882,7 @@ package body Sem_Aggr is -- Variables used to verify that discriminant-dependent components -- appear in the same variant. - Comp_Ref : Entity_Id; + Comp_Ref : Entity_Id := Empty; -- init to avoid warning Variant : Node_Id; procedure Check_Variant (Id : Entity_Id); @@ -2941,6 +2941,7 @@ package body Sem_Aggr is or else (D2 > D1 and then not Nested_In (Comp_Variant, Variant)) then + pragma Assert (Present (Comp_Ref)); Error_Msg_Node_2 := Comp_Ref; Error_Msg_NE ("& and & appear in different variants", Id, Comp); @@ -3025,7 +3026,7 @@ package body Sem_Aggr is Assoc : Node_Id; Choice : Node_Id; - Comp_Type : Entity_Id; + Comp_Type : Entity_Id := Empty; -- init to avoid warning -- Start of processing for Resolve_Delta_Record_Aggregate @@ -3045,6 +3046,7 @@ package body Sem_Aggr is Next (Choice); end loop; + pragma Assert (Present (Comp_Type)); Analyze_And_Resolve (Expression (Assoc), Comp_Type); Next (Assoc); end loop; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 562653f58f4..6cdc9f3e21b 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4761,7 +4761,7 @@ package body Sem_Ch12 is Use_Clauses : array (1 .. Scope_Stack_Depth) of Node_Id; Curr_Scope : Entity_Id := Empty; - List : Elist_Id; + List : Elist_Id := No_Elist; -- init to avoid warning N_Instances : Nat := 0; Num_Inner : Nat := 0; Num_Scopes : Nat := 0; @@ -5136,7 +5136,7 @@ package body Sem_Ch12 is Chars => New_External_Name (Chars (Defining_Entity (N)), 'R')); - Act_Decl_Id : Entity_Id; + Act_Decl_Id : Entity_Id := Empty; -- init to avoid warning Act_Decl : Node_Id; Act_Spec : Node_Id; Act_Tree : Node_Id; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ccca8b7ff53..83d31081fac 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1360,6 +1360,8 @@ package body Sem_Ch13 is ----------------------------------- procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is + pragma Assert (Present (E)); + procedure Decorate (Asp : Node_Id; Prag : Node_Id); -- Establish linkages between an aspect and its corresponding pragma @@ -1578,6 +1580,7 @@ package body Sem_Ch13 is Ent : Node_Id; L : constant List_Id := Aspect_Specifications (N); + pragma Assert (Present (L)); Ins_Node : Node_Id := N; -- Insert pragmas/attribute definition clause after this node when no @@ -1605,8 +1608,6 @@ package body Sem_Ch13 is -- of visibility for the expression analysis. Thus, we just insert -- the pragma after the node N. - pragma Assert (Present (L)); - -- Loop through aspects Aspect := First (L); @@ -1906,9 +1907,6 @@ package body Sem_Ch13 is ----------------------------------------- procedure Analyze_Aspect_Implicit_Dereference is - Disc : Entity_Id; - Parent_Disc : Entity_Id; - begin if not Is_Type (E) or else not Has_Discriminants (E) then Error_Msg_N @@ -1924,45 +1922,56 @@ package body Sem_Ch13 is -- Missing synchronized types??? - Disc := First_Discriminant (E); - while Present (Disc) loop - if Chars (Expr) = Chars (Disc) - and then Ekind_In (Etype (Disc), - E_Anonymous_Access_Subprogram_Type, - E_Anonymous_Access_Type) - then - Set_Has_Implicit_Dereference (E); - Set_Has_Implicit_Dereference (Disc); - exit; - end if; + declare + Disc : Entity_Id := First_Discriminant (E); + begin + while Present (Disc) loop + if Chars (Expr) = Chars (Disc) + and then Ekind_In + (Etype (Disc), + E_Anonymous_Access_Subprogram_Type, + E_Anonymous_Access_Type) + then + Set_Has_Implicit_Dereference (E); + Set_Has_Implicit_Dereference (Disc); + exit; + end if; - Next_Discriminant (Disc); - end loop; + Next_Discriminant (Disc); + end loop; - -- Error if no proper access discriminant + -- Error if no proper access discriminant - if No (Disc) then - Error_Msg_NE ("not an access discriminant of&", Expr, E); - return; - end if; - end if; + if Present (Disc) then + -- For a type extension, check whether parent has + -- a reference discriminant, to verify that use is + -- proper. - -- For a type extension, check whether parent has a - -- reference discriminant, to verify that use is proper. - - if Is_Derived_Type (E) - and then Has_Discriminants (Etype (E)) - then - Parent_Disc := Get_Reference_Discriminant (Etype (E)); + if Is_Derived_Type (E) + and then Has_Discriminants (Etype (E)) + then + declare + Parent_Disc : constant Entity_Id := + Get_Reference_Discriminant (Etype (E)); + begin + if Present (Parent_Disc) + and then Corresponding_Discriminant (Disc) /= + Parent_Disc + then + Error_Msg_N + ("reference discriminant does not match " + & "discriminant of parent type", Expr); + end if; + end; + end if; - if Present (Parent_Disc) - and then Corresponding_Discriminant (Disc) /= Parent_Disc - then - Error_Msg_N - ("reference discriminant does not match discriminant " - & "of parent type", Expr); - end if; + else + Error_Msg_NE + ("not an access discriminant of&", Expr, E); + end if; + end; end if; + end Analyze_Aspect_Implicit_Dereference; ----------------------- @@ -6529,7 +6538,7 @@ package body Sem_Ch13 is Max : Uint; -- Minimum and maximum values of entries - Max_Node : Node_Id; + Max_Node : Node_Id := Empty; -- init to avoid warning -- Pointer to node for literal providing max value begin @@ -8384,7 +8393,7 @@ package body Sem_Ch13 is -- This is the expression for the result of the function. It is -- is build by connecting the component predicates with AND THEN. - Expr_M : Node_Id; + Expr_M : Node_Id := Empty; -- init to avoid warning -- This is the corresponding return expression for the Predicate_M -- function. It differs in that raise expressions are marked for -- special expansion (see Process_REs). @@ -9925,7 +9934,7 @@ package body Sem_Ch13 is -- this tagged type and the parent component. Tagged_Parent will point -- to this parent type. For all other cases, Tagged_Parent is Empty. - Parent_Last_Bit : Uint; + Parent_Last_Bit : Uint := No_Uint; -- init to avoid warning -- Relevant only if Tagged_Parent is set, Parent_Last_Bit indicates the -- last bit position for any field in the parent type. We only need to -- check overlap for fields starting below this point. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 4532ac43ec5..f2d1acfdc08 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1075,12 +1075,11 @@ package body Sem_Ch4 is else declare - Outermost : Node_Id; + Outermost : Node_Id := Empty; -- init to avoid warning P : Node_Id := N; begin while Present (P) loop - -- For object declarations we can climb to the node from -- its object definition branch or from its initializing -- expression. We prefer to mark the child node as the @@ -1095,7 +1094,7 @@ package body Sem_Ch4 is Outermost := P; end if; - -- Avoid climbing more than needed! + -- Avoid climbing more than needed exit when Stop_Subtree_Climbing (Nkind (P)) or else (Nkind (P) = N_Range @@ -9151,9 +9150,8 @@ package body Sem_Ch4 is declare Dup_Call_Node : constant Node_Id := New_Copy (New_Call_Node); - CW_Result : Boolean; - Prim_Result : Boolean; - pragma Unreferenced (CW_Result); + Ignore : Boolean; + Prim_Result : Boolean := False; begin if not CW_Test_Only then @@ -9168,7 +9166,7 @@ package body Sem_Ch4 is -- was found in order to report ambiguous calls. if not Prim_Result then - CW_Result := + Ignore := Try_Class_Wide_Operation (Call_Node => New_Call_Node, Node_To_Replace => Node_To_Replace); @@ -9178,7 +9176,7 @@ package body Sem_Ch4 is -- decoration if there is no ambiguity). else - CW_Result := + Ignore := Try_Class_Wide_Operation (Call_Node => Dup_Call_Node, Node_To_Replace => Node_To_Replace); diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index e84fda29331..4cc41e3acaa 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -404,7 +404,7 @@ package body Sem_Disp is Func : Entity_Id; Subp_Entity : Entity_Id; Indeterm_Ancestor_Call : Boolean := False; - Indeterm_Ctrl_Type : Entity_Id; + Indeterm_Ctrl_Type : Entity_Id := Empty; -- init to avoid warning Static_Tag : Node_Id := Empty; -- If a controlling formal has a statically tagged actual, the tag of diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 78876ffbf25..55da40b7296 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5817,8 +5817,8 @@ package body Sem_Prag is procedure Check_Grouping (L : List_Id) is HSS : Node_Id; - Prag : Node_Id; Stmt : Node_Id; + Prag : Node_Id := Empty; -- init to avoid warning begin -- Inspect the list of declarations or statements looking for @@ -5872,16 +5872,15 @@ package body Sem_Prag is else while Present (Stmt) loop - -- The current pragma is either the first pragma - -- of the group or is a member of the group. Stop - -- the search as the placement is legal. + -- of the group or is a member of the group. + -- Stop the search as the placement is legal. if Stmt = N then raise Stop_Search; - -- Skip group members, but keep track of the last - -- pragma in the group. + -- Skip group members, but keep track of the + -- last pragma in the group. elsif Is_Loop_Pragma (Stmt) then Prag := Stmt; @@ -11390,6 +11389,7 @@ package body Sem_Prag is SPARK_Msg_N ("expression of external state property must be " & "static", Expr); + return; end if; -- The lack of expression defaults the property to True @@ -16474,6 +16474,20 @@ package body Sem_Prag is return; end if; + -- Ada 2012 (AI05-0030): Cannot apply the implementation_kind + -- By_Protected_Procedure to the primitive procedure of a task + -- interface. + + if Chars (Arg2) = Name_By_Protected_Procedure + and then Is_Interface (Typ) + and then Is_Task_Interface (Typ) + then + Error_Pragma_Arg + ("implementation kind By_Protected_Procedure cannot be " + & "applied to a task interface primitive", Arg2); + return; + end if; + -- Procedures declared inside a protected type must be accepted elsif Ekind (Proc_Id) = E_Procedure @@ -16489,20 +16503,6 @@ package body Sem_Prag is return; end if; - -- Ada 2012 (AI05-0030): Cannot apply the implementation_kind - -- By_Protected_Procedure to the primitive procedure of a task - -- interface. - - if Chars (Arg2) = Name_By_Protected_Procedure - and then Is_Interface (Typ) - and then Is_Task_Interface (Typ) - then - Error_Pragma_Arg - ("implementation kind By_Protected_Procedure cannot be " - & "applied to a task interface primitive", Arg2); - return; - end if; - Record_Rep_Item (Proc_Id, N); end Implemented; @@ -24253,11 +24253,16 @@ package body Sem_Prag is else OK := Set_Warning_Switch (Chr); end if; - end if; - if not OK then + if not OK then + Error_Pragma_Arg + ("invalid warning switch character " & Chr, + Arg1); + end if; + + else Error_Pragma_Arg - ("invalid warning switch character " & Chr, + ("invalid wide character in warning switch ", Arg1); end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 2626d3a67a5..024b879fd14 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3144,12 +3144,12 @@ package body Sem_Res is Loc : constant Source_Ptr := Sloc (N); A : Node_Id; A_Id : Entity_Id; - A_Typ : Entity_Id; + A_Typ : Entity_Id := Empty; -- init to avoid warning F : Entity_Id; F_Typ : Entity_Id; Prev : Node_Id := Empty; Orig_A : Node_Id; - Real_F : Entity_Id; + Real_F : Entity_Id := Empty; -- init to avoid warning Real_Subp : Entity_Id; -- If the subprogram being called is an inherited operation for diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 4bfa31693ef..102da89e9ca 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -15448,7 +15448,7 @@ package body Sem_Util is Anc_Part : Node_Id; Assoc : Node_Id; Choice : Node_Id; - Comp_Typ : Entity_Id; + Comp_Typ : Entity_Id := Empty; -- init to avoid warning Expr : Node_Id; begin @@ -15524,6 +15524,7 @@ package body Sem_Util is -- The type of the choice must have preelaborable initialization if -- the association carries a <>. + pragma Assert (Present (Comp_Typ)); if Box_Present (Assoc) then if not Has_Preelaborable_Initialization (Comp_Typ) then return False; @@ -17558,8 +17559,8 @@ package body Sem_Util is L_Ndims : constant Nat := Number_Dimensions (L_Typ); R_Ndims : constant Nat := Number_Dimensions (R_Typ); - L_Index : Node_Id; - R_Index : Node_Id; + L_Index : Node_Id := Empty; -- init to ... + R_Index : Node_Id := Empty; -- ...avoid warnings L_Low : Node_Id; L_High : Node_Id; L_Len : Uint; -- 2.30.2