diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0da0147f605..438831ae919 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2009-04-10 Robert Dewar + + * sem_warn.adb: Minor reformatting + + * make.adb: Minor reformatting. + +2009-04-10 Gary Dismukes + + * exp_ch7.adb (Find_Final_List): When creating a finalization-chain + entity and the scope is a subprogram, retrieve the Sloc of the + subprogram's body rather than using the sloc of the spec, for better + line-stepping behavior in gdb. + (Wrap_Transient_Declaration): For the Sloc of nodes created with a list + controller, use the Sloc of the first declaration of the containing list + rather than that of the node that triggered creation of the list + controller. + 2009-04-10 Vincent Celier * prj-nmsc.adb (Check_Naming_Schemes): Initialize local variable Casing diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 334b99a48b5..c44c17f3e30 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1744,9 +1744,9 @@ package body Exp_Ch7 is S := Enclosing_Dynamic_Scope (E); end if; - -- When the finalization chain entity is 'Error', it means that - -- there should not be any chain at that level and that the - -- enclosing one should be used + -- When the finalization chain entity is 'Error', it means that there + -- should not be any chain at that level and that the enclosing one + -- should be used. -- This is a nasty kludge, see ??? note in exp_ch11 @@ -1758,9 +1758,34 @@ package body Exp_Ch7 is return New_Reference_To (RTE (RE_Global_Final_List), Sloc (E)); else if No (Finalization_Chain_Entity (S)) then - Id := - Make_Defining_Identifier (Sloc (S), - Chars => New_Internal_Name ('F')); + + -- In the case where the scope is a subprogram, retrieve the + -- Sloc of subprogram's body for association with the chain, + -- since using the Sloc of the spec would be confusing during + -- source-line stepping within the debugger. + + declare + Flist_Loc : Source_Ptr := Sloc (S); + Subp_Body : Node_Id; + + begin + if Ekind (S) in Subprogram_Kind then + Subp_Body := Unit_Declaration_Node (S); + + if Nkind (Subp_Body) /= N_Subprogram_Body then + Subp_Body := Corresponding_Body (Subp_Body); + end if; + + if Present (Subp_Body) then + Flist_Loc := Sloc (Subp_Body); + end if; + end if; + + Id := + Make_Defining_Identifier (Flist_Loc, + Chars => New_Internal_Name ('F')); + end; + Set_Finalization_Chain_Entity (S, Id); -- Set momentarily some semantics attributes to allow normal @@ -3367,13 +3392,14 @@ package body Exp_Ch7 is -- Finalize_One (_v2); procedure Wrap_Transient_Declaration (N : Node_Id) is - S : Entity_Id; - LC : Entity_Id := Empty; - Nodes : List_Id; - Loc : constant Source_Ptr := Sloc (N); - Enclosing_S : Entity_Id; - Uses_SS : Boolean; - Next_N : constant Node_Id := Next (N); + S : Entity_Id; + LC : Entity_Id := Empty; + Nodes : List_Id; + Loc : constant Source_Ptr := Sloc (N); + First_Decl_Loc : Source_Ptr; + Enclosing_S : Entity_Id; + Uses_SS : Boolean; + Next_N : constant Node_Id := Next (N); begin S := Current_Scope; @@ -3397,19 +3423,26 @@ package body Exp_Ch7 is if Present (Finalization_Chain_Entity (S)) then LC := Make_Defining_Identifier (Loc, New_Internal_Name ('L')); + -- Use the Sloc of the first declaration of N's containing list, to + -- maintain monotonicity of source-line stepping during debugging. + + First_Decl_Loc := Sloc (First (List_Containing (N))); + Nodes := New_List ( - Make_Object_Declaration (Loc, + Make_Object_Declaration (First_Decl_Loc, Defining_Identifier => LC, Object_Definition => - New_Reference_To (RTE (RE_Simple_List_Controller), Loc)), + New_Reference_To + (RTE (RE_Simple_List_Controller), First_Decl_Loc)), - Make_Object_Renaming_Declaration (Loc, + Make_Object_Renaming_Declaration (First_Decl_Loc, Defining_Identifier => Finalization_Chain_Entity (S), - Subtype_Mark => New_Reference_To (RTE (RE_Finalizable_Ptr), Loc), + Subtype_Mark => + New_Reference_To (RTE (RE_Finalizable_Ptr), First_Decl_Loc), Name => Make_Selected_Component (Loc, - Prefix => New_Reference_To (LC, Loc), - Selector_Name => Make_Identifier (Loc, Name_F)))); + Prefix => New_Reference_To (LC, First_Decl_Loc), + Selector_Name => Make_Identifier (First_Decl_Loc, Name_F)))); -- Put the declaration at the beginning of the declaration part -- to make sure it will be before all other actions that have been diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index ca1b98041a1..8a71f4c1568 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -4112,10 +4112,10 @@ package body Make is -- Never display -gnatea nor -gnatez - if Args (J).all /= "-gnatea" and then - Args (J).all /= "-gnatez" + if Args (J).all /= "-gnatea" + and then + Args (J).all /= "-gnatez" then - -- Do not display the mapping file argument automatically -- created when using a project file. diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 076355b7cd0..86592525104 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1888,9 +1888,9 @@ package body Sem_Warn is -- the renaming may be intended to re-export the unit. function Has_Visible_Entities (P : Entity_Id) return Boolean; - -- If a package has no declared entities, inhibit warning because - -- there is nothing to be referenced. The package may be in the - -- context just in order to carry a linker pragma for example. + -- This function determines if a package has any visible entities. + -- True is returned if there is at least one declared visible entity, + -- otherwise False is returned (e.g. case of only pragmas present). ------------------------- -- Check_Inner_Package -- @@ -2024,7 +2024,6 @@ package body Sem_Warn is E : Entity_Id; begin - -- If unit in context is not a package, it is a subprogram that -- is not called or a generic unit that is not instantiated -- in the current unit, and warning is appropriate. @@ -2110,7 +2109,11 @@ package body Sem_Warn is if Unit = Spec_Unit then Set_Unreferenced_In_Spec (Item); - -- Otherwise simple unreferenced message + -- Otherwise simple unreferenced message, but skip this + -- if no visible entities, because that is most likely a + -- case where warning would be false positive (e.g. a + -- package with only a linker options pragma and nothing + -- else or a pragma elaborate with a body library task). elsif Has_Visible_Entities (Entity (Name (Item))) then Error_Msg_N