diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b74401a4a56..3b7ae6bbef2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2014-07-29 Robert Dewar + + * errout.adb: Minor reformatting. + +2014-07-29 Hristian Kirtchev + + * exp_ch3.adb (Default_Initialize_Object): Add new variables + Abrt_Blk and Dummy. Generate a dummy temporary when aborts are + not allowed to ensure the symmetrical generation of symbols. + * exp_ch7.adb (Build_Object_Declarations): Remove variables A_Expr + and E_Decl. Add new variables Decl and Dummy. Generate a dummy + temporary when aborts are not allowed to ensure symmertrical + generation of symbols. + * exp_intr.adb (Expand_Unc_Deallocation): Add new variable + Dummy. Generate a dummy temporary when aborts are not allowed + to ensure symmertrical generation of symbols. + +2014-07-29 Ed Schonberg + + * exp_dbug.adb (Debug_Renaming_Declaration): For an object + renaming, indicate that the renamed entity itself needs debug + information. This is necessary if that entity is a temporary, + e.g. part of the expansion of an explicit dereference in an + iterator. + 2014-07-29 Thomas Quinot * errout.adb (Set_Error_Posted): When propagating flag to diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index a18627cb582..1274b31ea1c 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3008,12 +3008,11 @@ package body Errout is exit when Nkind (P) not in N_Subexpr; end loop; - if Nkind_In (P, - N_Pragma_Argument_Association, - N_Component_Association, - N_Discriminant_Association, - N_Generic_Association, - N_Parameter_Association) + if Nkind_In (P, N_Pragma_Argument_Association, + N_Component_Association, + N_Discriminant_Association, + N_Generic_Association, + N_Parameter_Association) then Set_Error_Posted (Parent (P)); end if; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 160cfea761f..f454768e104 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5031,6 +5031,7 @@ package body Exp_Ch3 is -- Local variables + Abrt_Blk : Node_Id; Abrt_HSS : Node_Id; Abrt_Id : Entity_Id; Abrt_Stmts : List_Id; @@ -5041,6 +5042,11 @@ package body Exp_Ch3 is Obj_Init : Node_Id := Empty; Obj_Ref : Node_Id; + Dummy : Entity_Id; + pragma Unreferenced (Dummy); + -- This variable captures an unused dummy internal entity, see the + -- comment associated with its use. + -- Start of processing for Default_Initialize_Object begin @@ -5205,47 +5211,53 @@ package body Exp_Ch3 is -- Step 3b: Build the abort block (if applicable) - -- The abort block is required when aborts are allowed and there is - -- at least one initialization call that needs protection. + -- The abort block is required when aborts are allowed in order to + -- protect both initialization calls. - if Abort_Allowed - and then Present (Comp_Init) - and then Present (Obj_Init) - then - -- Generate: - -- Abort_Defer; + if Present (Comp_Init) and then Present (Obj_Init) then + if Abort_Allowed then - Prepend_To (Fin_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer)); + -- Generate: + -- Abort_Defer; - -- Generate: - -- begin - -- Abort_Defer; - -- - -- at end - -- Abort_Undefer_Direct; - -- end; + Prepend_To + (Fin_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer)); - Abrt_Id := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'); - Set_Etype (Abrt_Id, Standard_Void_Type); - Set_Scope (Abrt_Id, Current_Scope); + -- Generate: + -- begin + -- Abort_Defer; + -- + -- at end + -- Abort_Undefer_Direct; + -- end; - Abrt_HSS := - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Fin_Stmts, - At_End_Proc => - New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc)); + Abrt_HSS := + Make_Handled_Sequence_Of_Statements (Loc, + Statements => Fin_Stmts, + At_End_Proc => + New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc)); - Abrt_Stmts := New_List ( - Make_Block_Statement (Loc, - Identifier => New_Occurrence_Of (Abrt_Id, Loc), - Declarations => No_List, - Handled_Statement_Sequence => Abrt_HSS)); + Abrt_Blk := + Make_Block_Statement (Loc, + Declarations => No_List, + Handled_Statement_Sequence => Abrt_HSS); - Expand_At_End_Handler (Abrt_HSS, Abrt_Id); + Add_Block_Identifier (Abrt_Blk, Abrt_Id); + Expand_At_End_Handler (Abrt_HSS, Abrt_Id); - -- Abort is not required, the construct from Step 3a is to be added - -- in the tree (either finalization block or single initialization - -- call). + Abrt_Stmts := New_List (Abrt_Blk); + + -- Abort is not required + + else + -- Generate a dummy entity to ensure that the internal symbols + -- are in sync when a unit is compiled with and without aborts. + + Dummy := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'); + Abrt_Stmts := Fin_Stmts; + end if; + + -- No initialization calls present else Abrt_Stmts := Fin_Stmts; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index ad7a1d20bf4..a714d20e829 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3134,8 +3134,12 @@ package body Exp_Ch7 is Loc : Source_Ptr; For_Package : Boolean := False) is - A_Expr : Node_Id; - E_Decl : Node_Id; + Decl : Node_Id; + + Dummy : Entity_Id; + pragma Unreferenced (Dummy); + -- This variable captures an unused dummy internal entity, see the + -- comment associated with its use. begin pragma Assert (Decls /= No_List); @@ -3164,56 +3168,61 @@ package body Exp_Ch7 is -- does not include routine Raise_From_Controlled_Operation which is the -- the sole user of flag Abort. - -- This is not needed for library-level finalizers as they are called - -- by the environment task and cannot be aborted. + -- This is not needed for library-level finalizers as they are called by + -- the environment task and cannot be aborted. - if Abort_Allowed - and then VM_Target = No_VM - and then not For_Package - then - Data.Abort_Id := Make_Temporary (Loc, 'A'); + if VM_Target = No_VM and then not For_Package then + if Abort_Allowed then + Data.Abort_Id := Make_Temporary (Loc, 'A'); - A_Expr := New_Occurrence_Of (RTE (RE_Triggered_By_Abort), Loc); + -- Generate: + -- Abort_Id : constant Boolean := ; - -- Generate: + Append_To (Decls, + Make_Object_Declaration (Loc, + Defining_Identifier => Data.Abort_Id, + Constant_Present => True, + Object_Definition => + New_Occurrence_Of (Standard_Boolean, Loc), + Expression => + New_Occurrence_Of (RTE (RE_Triggered_By_Abort), Loc))); - -- Abort_Id : constant Boolean := ; + -- Abort is not required - Append_To (Decls, - Make_Object_Declaration (Loc, - Defining_Identifier => Data.Abort_Id, - Constant_Present => True, - Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc), - Expression => A_Expr)); + else + -- Generate a dummy entity to ensure that the internal symbols are + -- in sync when a unit is compiled with and without aborts. + + Dummy := Make_Temporary (Loc, 'A'); + Data.Abort_Id := Empty; + end if; + + -- .NET/JVM or library-level finalizers else - -- No abort, .NET/JVM or library-level finalizers - - Data.Abort_Id := Empty; + Data.Abort_Id := Empty; end if; if Exception_Extra_Info then - Data.E_Id := Make_Temporary (Loc, 'E'); + Data.E_Id := Make_Temporary (Loc, 'E'); -- Generate: - -- E_Id : Exception_Occurrence; - E_Decl := + Decl := Make_Object_Declaration (Loc, Defining_Identifier => Data.E_Id, Object_Definition => New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc)); - Set_No_Initialization (E_Decl); + Set_No_Initialization (Decl); - Append_To (Decls, E_Decl); + Append_To (Decls, Decl); else - Data.E_Id := Empty; + Data.E_Id := Empty; end if; -- Generate: - -- Raised_Id : Boolean := False; Append_To (Decls, diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index cbd4c55d949..7337acc7c97 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -479,6 +479,13 @@ package body Exp_Dbug is Set_Debug_Info_Needed (Obj); + -- The renamed entity may be a temporary, e.g. the result of an + -- implicit dereference in an iterator. Indicate that the temporary + -- itself requires debug information. If the renamed entity comes + -- from source this is a no-op. + + Set_Debug_Info_Needed (Entity (Ren)); + -- Mark the object as internal so that it won't be initialized when -- pragma Initialize_Scalars or Normalize_Scalars is in use. diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index a4a498904f4..3c6eb7468fa 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -914,6 +914,7 @@ package body Exp_Intr is Finalizer_Data : Finalization_Exception_Data; Blk : Node_Id := Empty; + Blk_Id : Entity_Id; Deref : Node_Id; Final_Code : List_Id; Free_Arg : Node_Id; @@ -926,6 +927,11 @@ package body Exp_Intr is -- that we analyze some generated statements before properly attaching -- them to the tree, and that can disturb current value settings. + Dummy : Entity_Id; + pragma Unreferenced (Dummy); + -- This variable captures an unused dummy internal entity, see the + -- comment associated with its use. + begin -- Nothing to do if we know the argument is null @@ -1007,8 +1013,7 @@ package body Exp_Intr is -- protected by an abort defer/undefer pair. if Abort_Allowed then - Prepend_To (Final_Code, - Build_Runtime_Call (Loc, RE_Abort_Defer)); + Prepend_To (Final_Code, Build_Runtime_Call (Loc, RE_Abort_Defer)); Blk := Make_Block_Statement (Loc, Handled_Statement_Sequence => @@ -1016,9 +1021,15 @@ package body Exp_Intr is Statements => Final_Code, At_End_Proc => New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc))); + Add_Block_Identifier (Blk, Blk_Id); Append (Blk, Stmts); + else + -- Generate a dummy entity to ensure that the internal symbols are + -- in sync when a unit is compiled with and without aborts. + + Dummy := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'); Append_List_To (Stmts, Final_Code); end if; end if;