From: Arnaud Charlet Date: Wed, 6 Sep 2017 12:27:15 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5e9cb4046164bb8debe8b3c07c00158b7319739a;p=gcc.git [multiple changes] 2017-09-06 Ed Schonberg * sem_prag.adb (Check_Postcondition_Use_In_Inlined_Subprogram): Do not warn on conditions that are not obeyed for Inline_Always subprograms, when assertions are not enabled. 2017-09-06 Arnaud Charlet * sem_util.adb (Unique_Entity): For abstract states return their non-limited view. 2017-09-06 Bob Duff * sem_ch12.adb (Copy_Generic_Node): When we copy a node that is a proper body corresponding to a stub, we defer the adjustment of the sloc until after the correct adjustment has been computed. Otherwise, Adjust_Instantiation_Sloc will ignore the adjustment, because it will be outside the range in (the old, incorrect) S_Adjustment. * inline.adb: Use named notation for readability and uniformity. * sinput-l.adb: Minor improvements to debugging output printed for Debug_Flag_L. * sinput-l.ads (Create_Instantiation_Source): Minor comment correction. 2017-09-06 Vincent Celier * make.adb: Do not invoke gprbuild for -bargs -P. 2017-09-06 Sylvain Dailler * sem_eval.adb (Compile_Time_Known_Value_Or_Aggr): Adding a case when Op is of kind N_Qualified_Expression. In this case, the function is called recursively on the subexpression like in other cases. * make.adb: Minor reformatting 2017-09-06 Justin Squirek * einfo.adb (Set_Linker_Section_Pragma): Modify Set_Linker_Section_Pragma to be consistant with the "getter" Linker_Section_Pragma. * exp_ch5.adb (Expand_Formal_Container_Loop): Add proper error checking for container loops so that the index cursor is not directly changable by the user with the use of E_Loop_Parameter. * sem_ch5.adb (Analyze_Block_Statement): Revert previous change. * sem_warn.adb (Check_References): Revert previous change. From-SVN: r251789 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 385c663d601..86f78c64cf8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,51 @@ +2017-09-06 Ed Schonberg + + * sem_prag.adb (Check_Postcondition_Use_In_Inlined_Subprogram): + Do not warn on conditions that are not obeyed for Inline_Always + subprograms, when assertions are not enabled. + +2017-09-06 Arnaud Charlet + + * sem_util.adb (Unique_Entity): For abstract states return their + non-limited view. + +2017-09-06 Bob Duff + + * sem_ch12.adb (Copy_Generic_Node): When we copy a node + that is a proper body corresponding to a stub, we defer the + adjustment of the sloc until after the correct adjustment has + been computed. Otherwise, Adjust_Instantiation_Sloc will ignore + the adjustment, because it will be outside the range in (the old, + incorrect) S_Adjustment. + * inline.adb: Use named notation for readability and uniformity. + * sinput-l.adb: Minor improvements to debugging output printed + for Debug_Flag_L. + * sinput-l.ads (Create_Instantiation_Source): Minor comment + correction. + +2017-09-06 Vincent Celier + + * make.adb: Do not invoke gprbuild for -bargs -P. + +2017-09-06 Sylvain Dailler + + * sem_eval.adb (Compile_Time_Known_Value_Or_Aggr): Adding a + case when Op is of kind N_Qualified_Expression. In this case, + the function is called recursively on the subexpression like in + other cases. + * make.adb: Minor reformatting + +2017-09-06 Justin Squirek + + * einfo.adb (Set_Linker_Section_Pragma): Modify + Set_Linker_Section_Pragma to be consistant with the "getter" + Linker_Section_Pragma. + * exp_ch5.adb (Expand_Formal_Container_Loop): Add proper error + checking for container loops so that the index cursor is not + directly changable by the user with the use of E_Loop_Parameter. + * sem_ch5.adb (Analyze_Block_Statement): Revert previous change. + * sem_warn.adb (Check_References): Revert previous change. + 2017-09-06 Eric Botcazou * gcc-interface/trans.c (gnat_to_gnu) : Try diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 51793b07596..2f473e2d387 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -30,7 +30,6 @@ with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; with Osint.M; use Osint.M; --- with Sdefault; with Snames; with Stringt; with Switch; use Switch; @@ -48,8 +47,8 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package body Clean is Initialized : Boolean := False; - -- Set to True by the first call to Initialize to avoid reinitialization - -- of some packages. + -- Set to True by the first call to Initialize to avoid reinitialization of + -- some packages. -- Suffixes of various files diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index b7782a9ab9a..4ad9466404f 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -2756,7 +2756,7 @@ package body Einfo is function Linker_Section_Pragma (Id : E) return N is begin pragma Assert - (Is_Type (Id) or else Is_Object (Id) or else Is_Subprogram (Id)); + (Is_Object (Id) or else Is_Subprogram (Id) or else Is_Type (Id)); return Node33 (Id); end Linker_Section_Pragma; @@ -5918,9 +5918,8 @@ package body Einfo is procedure Set_Linker_Section_Pragma (Id : E; V : N) is begin - pragma Assert (Is_Type (Id) - or else Ekind_In (Id, E_Constant, E_Variable) - or else Is_Subprogram (Id)); + pragma Assert + (Is_Object (Id) or else Is_Subprogram (Id) or else Is_Type (Id)); Set_Node33 (Id, V); end Set_Linker_Section_Pragma; @@ -7368,6 +7367,39 @@ package body Einfo is return Empty; end Get_Attribute_Definition_Clause; + --------------------------- + -- Get_Class_Wide_Pragma -- + --------------------------- + + function Get_Class_Wide_Pragma + (E : Entity_Id; + Id : Pragma_Id) return Node_Id + is + Item : Node_Id; + Items : Node_Id; + + begin + Items := Contract (E); + + if No (Items) then + return Empty; + end if; + + Item := Pre_Post_Conditions (Items); + while Present (Item) loop + if Nkind (Item) = N_Pragma + and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id + and then Class_Present (Item) + then + return Item; + end if; + + Item := Next_Pragma (Item); + end loop; + + return Empty; + end Get_Class_Wide_Pragma; + ------------------- -- Get_Full_View -- ------------------- @@ -7481,39 +7513,6 @@ package body Einfo is return Empty; end Get_Pragma; - -------------------------- - -- Get_Classwide_Pragma -- - -------------------------- - - function Get_Classwide_Pragma - (E : Entity_Id; - Id : Pragma_Id) return Node_Id - is - Item : Node_Id; - Items : Node_Id; - - begin - Items := Contract (E); - if No (Items) then - return Empty; - end if; - - Item := Pre_Post_Conditions (Items); - - while Present (Item) loop - if Nkind (Item) = N_Pragma - and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id - and then Class_Present (Item) - then - return Item; - else - Item := Next_Pragma (Item); - end if; - end loop; - - return Empty; - end Get_Classwide_Pragma; - -------------------------------------- -- Get_Record_Representation_Clause -- -------------------------------------- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index f14b22f826b..2fcdac70e30 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -8295,11 +8295,11 @@ package Einfo is -- Test_Case -- Volatile_Function - function Get_Classwide_Pragma + function Get_Class_Wide_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id; - -- Examine Rep_Item chain to locate a classwide pre- or postcondition - -- of a primitive operation. Returns Empty if not present. + -- Examine Rep_Item chain to locate a classwide pre- or postcondition of a + -- primitive operation. Returns Empty if not present. function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id; -- Searches the Rep_Item chain for a given entity E, for a record diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 981137d4309..14249f0d278 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -211,7 +211,8 @@ package body Exp_Ch5 is Make_Iteration_Scheme (Loc, Condition => Make_Function_Call (Loc, - Name => New_Occurrence_Of (Has_Element_Op, Loc), + Name => + New_Occurrence_Of (Has_Element_Op, Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Container, Loc), New_Occurrence_Of (Cursor, Loc)))), @@ -3081,15 +3082,15 @@ package body Exp_Ch5 is Container : constant Node_Id := Entity (Name (I_Spec)); Stats : constant List_Id := Statements (N); - Advance : Node_Id; - Blk_Nod : Node_Id; - Init : Node_Id; - New_Loop : Node_Id; + Advance : Node_Id; + Init_Decl : Node_Id; + New_Loop : Node_Id; begin - -- The expansion resembles the one for Ada containers, but the - -- primitives mention the domain of iteration explicitly, and - -- function First applied to the container yields a cursor directly. + -- The expansion of a formal container loop resembles the one for Ada + -- containers. The only difference is that the primitives mention the + -- domain of iteration explicitly, and function First applied to the + -- container yields a cursor directly. -- Cursor : Cursor_type := First (Container); -- while Has_Element (Cursor, Container) loop @@ -3098,21 +3099,34 @@ package body Exp_Ch5 is -- end loop; Build_Formal_Container_Iteration - (N, Container, Cursor, Init, Advance, New_Loop); + (N, Container, Cursor, Init_Decl, Advance, New_Loop); - Set_Ekind (Cursor, E_Variable); Append_To (Stats, Advance); - -- Build block to capture declaration of cursor entity. + -- Build a block to capture declaration of the cursor - Blk_Nod := + Rewrite (N, Make_Block_Statement (Loc, - Declarations => New_List (Init), + Declarations => New_List (Init_Decl), Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (New_Loop))); + Statements => New_List (New_Loop)))); + + -- The loop parameter is declared by an object declaration, but within + -- the loop we must prevent user assignments to it, so we analyze the + -- declaration and reset the entity kind, before analyzing the rest of + -- the loop. + + Analyze (Init_Decl); + Set_Ekind (Defining_Identifier (Init_Decl), E_Loop_Parameter); + + -- The cursor was marked as a loop parameter to prevent user assignments + -- to it, however this renders the advancement step illegal as it is not + -- possible to change the value of a constant. Flag the advancement step + -- as a legal form of assignment to remedy this side effect. + + Set_Assignment_OK (Name (Advance)); - Rewrite (N, Blk_Nod); Analyze (N); end Expand_Formal_Container_Loop; @@ -3236,7 +3250,7 @@ package body Exp_Ch5 is -- The loop parameter is declared by an object declaration, but within -- the loop we must prevent user assignments to it, so we analyze the -- declaration and reset the entity kind, before analyzing the rest of - -- the loop; + -- the loop. Analyze (Elmt_Decl); Set_Ekind (Defining_Identifier (Elmt_Decl), E_Loop_Parameter); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index bf76970c0d9..619c921b76c 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1418,7 +1418,8 @@ package body Freeze is New_Prag : Node_Id; begin - A_Pre := Get_Classwide_Pragma (Par_Prim, Pragma_Precondition); + A_Pre := Get_Class_Wide_Pragma (Par_Prim, Pragma_Precondition); + if Present (A_Pre) then New_Prag := New_Copy_Tree (A_Pre); Build_Class_Wide_Expression @@ -1436,7 +1437,7 @@ package body Freeze is end if; end if; - A_Post := Get_Classwide_Pragma (Par_Prim, Pragma_Postcondition); + A_Post := Get_Class_Wide_Pragma (Par_Prim, Pragma_Postcondition); if Present (A_Post) then New_Prag := New_Copy_Tree (A_Post); diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 70d1f84866a..bc0428e3551 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -1058,7 +1058,7 @@ package body Inline is if In_Instance and then Scope (Current_Scope) /= Standard_Standard then Save_Env (Scope (Current_Scope), Scope (Current_Scope)); - Original_Body := Copy_Generic_Node (N, Empty, True); + Original_Body := Copy_Generic_Node (N, Empty, Instantiating => True); else Original_Body := Copy_Separate_Tree (N); end if; @@ -1081,7 +1081,8 @@ package body Inline is Remove_Aspects_And_Pragmas (Original_Body); - Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False); + Body_To_Analyze := + Copy_Generic_Node (Original_Body, Empty, Instantiating => False); -- Set return type of function, which is also global and does not need -- to be resolved. @@ -1635,7 +1636,8 @@ package body Inline is if In_Instance and then Scope (Current_Scope) /= Standard_Standard then - Body_To_Inline := Copy_Generic_Node (N, Empty, True); + Body_To_Inline := + Copy_Generic_Node (N, Empty, Instantiating => True); else Body_To_Inline := Copy_Separate_Tree (N); end if; @@ -1688,7 +1690,8 @@ package body Inline is -- parameterless subprogram, declared within the real one. Generate_Subprogram_Body (N, Original_Body); - Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False); + Body_To_Analyze := + Copy_Generic_Node (Original_Body, Empty, Instantiating => False); -- Set return type of function, which is also global and does not -- need to be resolved. diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index ae17868f57e..cbd110dc8f0 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -3746,6 +3746,10 @@ package body Make is Success : Boolean; Target : String_Access := null; + In_Gnatmake_Switches : Boolean := True; + -- Set to False after -cargs, -bargs, or -largs, to avoid detecting + -- -P switches that are not for gnatmake. + begin Find_Program_Name; @@ -3761,7 +3765,14 @@ package body Make is declare Arg : constant String := Argument (J); begin - if Arg'Length >= 2 + if Arg = "-cargs" or Arg = "-bargs" or Arg = "-largs" then + In_Gnatmake_Switches := False; + + elsif Arg = "-margs" then + In_Gnatmake_Switches := True; + + elsif In_Gnatmake_Switches + and then Arg'Length >= 2 and then Arg (Arg'First .. Arg'First + 1) = "-P" then Call_Gprbuild := True; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index f0f102e419b..3635319884b 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1895,25 +1895,28 @@ package body Sem_Ch12 is (Formal, Match, Analyzed_Formal), Assoc_List); - -- Determine whether the actual package needs an - -- explicit freeze node. This is only the case if - -- the actual is declared in the same unit and has - -- a body. Normally packages do not have explicit - -- freeze nodes, and gigi only uses them to elaborate - -- entities in a package body. + -- Determine whether the actual package needs an explicit + -- freeze node. This is only the case if the actual is + -- declared in the same unit and has a body. Normally + -- packages do not have explicit freeze nodes, and gigi + -- only uses them to elaborate entities in a package + -- body. declare Actual : constant Entity_Id := Entity (Match); + Needs_Freezing : Boolean; - S : Entity_Id; + S : Entity_Id; begin if not Expander_Active or else not Has_Completion (Actual) or else not In_Same_Source_Unit (I_Node, Actual) - or else (Present (Renamed_Entity (Actual)) - and then not In_Same_Source_Unit (I_Node, - (Renamed_Entity (Actual)))) + or else + (Present (Renamed_Entity (Actual)) + and then not + In_Same_Source_Unit + (I_Node, (Renamed_Entity (Actual)))) then null; @@ -1921,17 +1924,21 @@ package body Sem_Ch12 is -- Finally we want to exclude such freeze nodes -- from statement sequences, which freeze -- everything before them. - -- Is this strictly necesssary ??? + -- Is this strictly necessary ??? Needs_Freezing := True; + S := Current_Scope; while Present (S) loop - if Ekind_In - (S, E_Loop, E_Block, E_Procedure, E_Function) + if Ekind_In (S, E_Block, + E_Function, + E_Loop, + E_Procedure) then Needs_Freezing := False; exit; end if; + S := Scope (S); end loop; @@ -2648,7 +2655,9 @@ package body Sem_Ch12 is (Generic_Formal_Declarations (Original_Node (Gen_Decl))); while Present (Formal_Decl) loop Append_To - (Decls, Copy_Generic_Node (Formal_Decl, Empty, True)); + (Decls, + Copy_Generic_Node + (Formal_Decl, Empty, Instantiating => True)); Next (Formal_Decl); end loop; end; @@ -5586,7 +5595,7 @@ package body Sem_Ch12 is Assoc := Associated_Node (Assoc); end loop; - -- Follow and additional link in case the final node was rewritten. + -- Follow an additional link in case the final node was rewritten. -- This can only happen with nested generic units. if (Nkind (Assoc) = N_Identifier or else Nkind (Assoc) in N_Op) @@ -5603,7 +5612,7 @@ package body Sem_Ch12 is -- An additional special case: an unconstrained type in an object -- declaration may have been rewritten as a local subtype constrained -- by the expression in the declaration. We need to recover the - -- original entity which may be global. + -- original entity, which may be global. if Present (Original_Node (Assoc)) and then Nkind (Parent (N)) = N_Object_Declaration @@ -7450,7 +7459,16 @@ package body Sem_Ch12 is (New_N, Copy_Generic_List (Aspect_Specifications (N), Parent_Id)); end if; - if Instantiating then + -- If we are instantiating, we want to adjust the sloc based on the + -- current S_Adjustment. However, if this is the root node of a subunit, + -- we need to defer that adjustment to below (see "elsif Instantiating + -- and Was_Stub"), so it comes after Create_Instantiation_Source has + -- computed the adjustment. + + if Instantiating + and then not (Nkind (N) in N_Proper_Body + and then Was_Originally_Stub (N)) + then Adjust_Instantiation_Sloc (New_N, S_Adjustment); end if; @@ -7594,18 +7612,16 @@ package body Sem_Ch12 is Set_Selector_Name (New_N, Copy_Generic_Node (Selector_Name (N), New_N, Instantiating)); - -- For operators, we must copy the right operand + -- For operators, copy the operands elsif Nkind (N) in N_Op then - Set_Right_Opnd (New_N, - Copy_Generic_Node (Right_Opnd (N), New_N, Instantiating)); - - -- And for binary operators, the left operand as well - if Nkind (N) in N_Binary_Op then Set_Left_Opnd (New_N, Copy_Generic_Node (Left_Opnd (N), New_N, Instantiating)); end if; + + Set_Right_Opnd (New_N, + Copy_Generic_Node (Right_Opnd (N), New_N, Instantiating)); end if; -- Establish a link between an entity from the generic template and the @@ -7751,14 +7767,16 @@ package body Sem_Ch12 is Copy_Generic_List (Context_Items (N), New_N)); Set_Unit (New_N, - Copy_Generic_Node (Unit (N), New_N, False)); + Copy_Generic_Node (Unit (N), New_N, Instantiating => False)); Set_First_Inlined_Subprogram (New_N, Copy_Generic_Node - (First_Inlined_Subprogram (N), New_N, False)); + (First_Inlined_Subprogram (N), New_N, Instantiating => False)); - Set_Aux_Decls_Node (New_N, - Copy_Generic_Node (Aux_Decls_Node (N), New_N, False)); + Set_Aux_Decls_Node + (New_N, + Copy_Generic_Node + (Aux_Decls_Node (N), New_N, Instantiating => False)); -- For an assignment node, the assignment is known to be semantically -- legal if we are instantiating the template. This avoids incorrect @@ -7873,13 +7891,14 @@ package body Sem_Ch12 is elsif Nkind (N) in N_Proper_Body then declare Save_Adjustment : constant Sloc_Adjustment := S_Adjustment; - begin if Instantiating and then Was_Originally_Stub (N) then Create_Instantiation_Source (Instantiation_Node, Defining_Entity (N), S_Adjustment); + + Adjust_Instantiation_Sloc (New_N, S_Adjustment); end if; -- Now copy the fields of the proper body, using the new @@ -7887,7 +7906,7 @@ package body Sem_Ch12 is Copy_Descendants; - -- Restore the original adjustment factor in case changed + -- Restore the original adjustment factor S_Adjustment := Save_Adjustment; end; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0ec2e846386..bda8fae37c6 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5718,7 +5718,7 @@ package body Sem_Ch3 is then declare Partial : constant Entity_Id := - Incomplete_Or_Partial_View (First_Subtype (Id)); + Incomplete_Or_Partial_View (First_Subtype (Id)); begin if Present (Partial) and then Ekind (Partial) = E_Incomplete_Type diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 35f5e7c9fe0..12ca7a0c291 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1111,10 +1111,7 @@ package body Sem_Ch5 is end loop; end if; - if Comes_From_Source (Ent) then - Check_References (Ent); - end if; - + Check_References (Ent); End_Scope; if Unblocked_Exit_Count = 0 then @@ -1905,8 +1902,8 @@ package body Sem_Ch5 is Preanalyze_Range (Iter_Name); - -- Set the kind of the loop variable, which is not visible within - -- the iterator name. + -- Set the kind of the loop variable, which is not visible within the + -- iterator name. Set_Ekind (Def_Id, E_Variable); diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 5a40ed97630..41713307cd6 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -1828,6 +1828,9 @@ package body Sem_Eval is return True; + elsif Nkind (Op) = N_Qualified_Expression then + return Compile_Time_Known_Value_Or_Aggr (Expression (Op)); + -- All other types of values are not known at compile time else diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f696655d651..91bcf944a0e 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -197,8 +197,9 @@ package body Sem_Prag is (Prag : Node_Id; Spec_Id : Entity_Id); -- Subsidiary to the analysis of pragmas Contract_Cases, Postcondition, - -- Precondition, Refined_Post and Test_Case. Emit a warning when pragma - -- Prag is associated with subprogram Spec_Id subject to Inline_Always. + -- Precondition, Refined_Post, and Test_Case. Emit a warning when pragma + -- Prag is associated with subprogram Spec_Id subject to Inline_Always, + -- and assertions are enabled. procedure Check_State_And_Constituent_Use (States : Elist_Id; @@ -27996,6 +27997,7 @@ package body Sem_Prag is begin if Warn_On_Redundant_Constructs and then Has_Pragma_Inline_Always (Spec_Id) + and then Assertions_Enabled then Error_Msg_Name_1 := Original_Aspect_Pragma_Name (Prag); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d20cafbe63b..237d410be82 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -22116,7 +22116,7 @@ package body Sem_Util is Prot_Type := Scope (E); -- Bodies of entry families are nested within an extra scope - -- that contains an entry index declaration + -- that contains an entry index declaration. else Prot_Type := Scope (Scope (E)); diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index cfc3f1312c9..c8136b0d7fc 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1670,17 +1670,17 @@ package body Sem_Warn is end if; end if; - -- Recurse into a nested package or non-internal block, but do not - -- recurse into a formal package because the corresponding body is - -- not analyzed. + -- Recurse into nested package or block. Do not recurse into a formal + -- package, because the corresponding body is not analyzed. <> if (Is_Package_Or_Generic_Package (E1) and then Nkind (Parent (E1)) = N_Package_Specification and then Nkind (Original_Node (Unit_Declaration_Node (E1))) /= - N_Formal_Package_Declaration) - or else (Ekind (E1) = E_Block and then not Is_Internal (E1)) + N_Formal_Package_Declaration) + + or else Ekind (E1) = E_Block then Check_References (E1); end if; diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index a64283ec42e..d7e337b35a2 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -103,7 +103,7 @@ package body Sinput.L is -- case, but in practice there seem to be some nodes that get copied -- twice, and this is a defence against that happening. - if Factor.Lo <= Loc and then Loc <= Factor.Hi then + if Loc in Factor.Lo .. Factor.Hi then Set_Sloc (N, Loc + Factor.Adjust); end if; end Adjust_Instantiation_Sloc; @@ -143,7 +143,8 @@ package body Sinput.L is Xnew := Source_File.Last; if Debug_Flag_L then - Write_Str ("Create_Instantiation_Source: created source "); + Write_Eol; + Write_Str ("*** Create_Instantiation_Source: created source "); Write_Int (Int (Xnew)); Write_Line (""); end if; @@ -250,8 +251,7 @@ package body Sinput.L is end; if Debug_Flag_L then - Write_Eol; - Write_Str ("*** Create instantiation source for "); + Write_Str (" for "); if Nkind (Dnod) in N_Proper_Body and then Was_Originally_Stub (Dnod) @@ -291,10 +291,6 @@ package body Sinput.L is Write_Name (Chars (Template_Id)); Write_Eol; - Write_Str (" new source index = "); - Write_Int (Int (Xnew)); - Write_Eol; - Write_Str (" copying from file name = "); Write_Name (File_Name (Xold)); Write_Eol; @@ -401,11 +397,11 @@ package body Sinput.L is X := Source_File.Last; if Debug_Flag_L then + Write_Eol; Write_Str ("Sinput.L.Load_File: created source "); Write_Int (Int (X)); Write_Str (" for "); Write_Str (Get_Name_String (N)); - Write_Line (""); end if; -- Compute starting index, respecting alignment requirement diff --git a/gcc/ada/sinput-l.ads b/gcc/ada/sinput-l.ads index f3af4c90b50..f4a3ccfaadf 100644 --- a/gcc/ada/sinput-l.ads +++ b/gcc/ada/sinput-l.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -100,13 +100,16 @@ package Sinput.L is -- Inst_Node is the instantiation node, and Template_Id is the defining -- identifier of the generic declaration or body unit as appropriate. -- Factor is set to an adjustment factor to be used in subsequent calls to - -- Adjust_Instantiation_Sloc. The instantiation mechanism is also used for - -- inlined function and procedure calls. The parameter Inlined_Body is set - -- to True in such cases. This is used for generating error messages that - -- distinguish these two cases, otherwise the two cases are handled - -- identically. Similarly, the instantiation mechanism is also used for - -- inherited class-wide pre- and postconditions. Parameter Inherited_Pragma - -- is set to True in such cases. + -- Adjust_Instantiation_Sloc. Template_Id can also be a subunit body that + -- replaces a stub in a generic unit. + -- + -- The instantiation mechanism is also used for inlined function and + -- procedure calls. The parameter Inlined_Body is set to True in such + -- cases. This is used for generating error messages that distinguish these + -- two cases, otherwise the two cases are handled identically. Similarly, + -- the instantiation mechanism is also used for inherited class-wide pre- + -- and postconditions. Parameter Inherited_Pragma is set to True in such + -- cases. private