From 8c5b03a08edcee621c86f18bf0c1eb829ea3d12c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 1 Sep 2011 12:48:23 +0200 Subject: [PATCH] [multiple changes] 2011-09-01 Hristian Kirtchev * exp_ch7.adb (Find_Insertion_List): New routine. (Process_Transient_Objects): Add code to handle the abnormal finalization of a controlled transient associated with a subprogram call. Since transients are cleaned up right after the associated context, an exception raised during a subprogram call may bypass the finalization code. 2011-09-01 Robert Dewar * exp_ch6.adb (Expand_Call): Check actual for aliased parameter is aliased. From-SVN: r178403 --- gcc/ada/ChangeLog | 14 +++ gcc/ada/exp_ch6.adb | 19 ++-- gcc/ada/exp_ch7.adb | 212 ++++++++++++++++++++++++++++++++++++-------- 3 files changed, 204 insertions(+), 41 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 46e33deddce..ca4fecd279e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2011-09-01 Hristian Kirtchev + + * exp_ch7.adb (Find_Insertion_List): New routine. + (Process_Transient_Objects): Add code to handle the abnormal + finalization of a controlled transient associated with a subprogram + call. Since transients are cleaned up right after the associated + context, an exception raised during a subprogram call may bypass the + finalization code. + +2011-09-01 Robert Dewar + + * exp_ch6.adb (Expand_Call): Check actual for aliased parameter is + aliased. + 2011-09-01 Robert Dewar * exp_ch4.adb, a-exexda.adb: Minor reformatting. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 6780f6e8998..f9b3ae59930 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2208,8 +2208,8 @@ package body Exp_Ch6 is -- as we go through the loop, since this is a convenient place to do it. -- (Though it seems that this would be better done in Expand_Actuals???) - Formal := First_Formal (Subp); - Actual := First_Actual (Call_Node); + Formal := First_Formal (Subp); + Actual := First_Actual (Call_Node); Param_Count := 1; while Present (Formal) loop @@ -2235,7 +2235,7 @@ package body Exp_Ch6 is CW_Interface_Formals_Present or else (Ekind (Etype (Formal)) = E_Class_Wide_Type - and then Is_Interface (Etype (Etype (Formal)))) + and then Is_Interface (Etype (Etype (Formal)))) or else (Ekind (Etype (Formal)) = E_Anonymous_Access_Type and then Is_Interface (Directly_Designated_Type @@ -2616,6 +2616,15 @@ package body Exp_Ch6 is end if; end if; + -- For Ada 2012, if a parameter is aliased, the actual must be an + -- aliased object. + + if Is_Aliased (Formal) and then not Is_Aliased_View (Actual) then + Error_Msg_NE + ("actual for aliased formal& must be aliased object", + Actual, Formal); + end if; + -- For IN OUT and OUT parameters, ensure that subscripts are valid -- since this is a left side reference. We only do this for calls -- from the source program since we assume that compiler generated @@ -2667,9 +2676,7 @@ package body Exp_Ch6 is -- or IN OUT parameter! We do reset the Is_Known_Valid flag -- since the subprogram could have returned in invalid value. - if (Ekind (Formal) = E_Out_Parameter - or else - Ekind (Formal) = E_In_Out_Parameter) + if Ekind_In (Formal, E_Out_Parameter, E_In_Out_Parameter) and then Is_Assignable (Ent) then Sav := Last_Assignment (Ent); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 09015394f1e..30abe6c9e62 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4198,17 +4198,51 @@ package body Exp_Ch7 is Last_Object : Node_Id; Related_Node : Node_Id) is - Finalizer_Data : Finalization_Exception_Data; - Finalizer_Decls : List_Id; - Built : Boolean := False; - Desig : Entity_Id; - Fin_Block : Node_Id; - Last_Fin : Node_Id := Empty; - Loc : Source_Ptr; - Obj_Id : Entity_Id; - Obj_Ref : Node_Id; - Obj_Typ : Entity_Id; - Stmt : Node_Id; + function Find_Insertion_List return List_Id; + -- Return the statement list of the enclosing sequence of statements + + ------------------------- + -- Find_Insertion_List -- + ------------------------- + + function Find_Insertion_List return List_Id is + Par : Node_Id; + + begin + -- Climb up the tree looking for the enclosing sequence of + -- statements. + + Par := N; + while Present (Par) + and then Nkind (Par) /= N_Handled_Sequence_Of_Statements + loop + Par := Parent (Par); + end loop; + + return Statements (Par); + end Find_Insertion_List; + + -- Local variables + + Requires_Hooking : constant Boolean := + Nkind_In (N, N_Function_Call, + N_Procedure_Call_Statement); + + Built : Boolean := False; + Desig_Typ : Entity_Id; + Fin_Block : Node_Id; + Fin_Data : Finalization_Exception_Data; + Fin_Decls : List_Id; + Last_Fin : Node_Id := Empty; + Loc : Source_Ptr; + Obj_Id : Entity_Id; + Obj_Ref : Node_Id; + Obj_Typ : Entity_Id; + Stmt : Node_Id; + Stmts : List_Id; + Temp_Id : Entity_Id; + + -- Start of processing for Process_Transient_Objects begin -- Examine all objects in the list First_Object .. Last_Object @@ -4224,34 +4258,151 @@ package body Exp_Ch7 is and then Stmt /= Related_Node then - Loc := Sloc (Stmt); - Obj_Id := Defining_Identifier (Stmt); - Obj_Typ := Base_Type (Etype (Obj_Id)); - Desig := Obj_Typ; + Loc := Sloc (Stmt); + Obj_Id := Defining_Identifier (Stmt); + Obj_Typ := Base_Type (Etype (Obj_Id)); + Desig_Typ := Obj_Typ; Set_Is_Processed_Transient (Obj_Id); -- Handle access types - if Is_Access_Type (Desig) then - Desig := Available_View (Designated_Type (Desig)); + if Is_Access_Type (Desig_Typ) then + Desig_Typ := Available_View (Designated_Type (Desig_Typ)); end if; -- Create the necessary entities and declarations the first -- time around. if not Built then - Finalizer_Decls := New_List; - Build_Object_Declarations - (Finalizer_Data, Finalizer_Decls, Loc); + Fin_Decls := New_List; - Insert_List_Before_And_Analyze - (First_Object, Finalizer_Decls); + Build_Object_Declarations (Fin_Data, Fin_Decls, Loc); + Insert_List_Before_And_Analyze (First_Object, Fin_Decls); Built := True; end if; + -- Transient variables associated with subprogram calls need + -- extra processing. These variables are usually created right + -- before the call and finalized immediately after the call. + -- If an exception occurs during the call, the clean up code + -- is skipped due to the sudden change in control and the + -- transient is never finalized. + + -- To handle this case, such variables are "exported" to the + -- enclosing sequence of statements where their corresponding + -- "hooks" are picked up by the finalization machinery. + + if Requires_Hooking then + declare + Ins_List : constant List_Id := Find_Insertion_List; + Expr : Node_Id; + Ptr_Decl : Node_Id; + Ptr_Id : Entity_Id; + Temp_Decl : Node_Id; + + begin + -- Step 1: Create an access type which provides a + -- reference to the transient object. Generate: + + -- Ann : access [all] ; + + Ptr_Id := Make_Temporary (Loc, 'A'); + + Ptr_Decl := + Make_Full_Type_Declaration (Loc, + Defining_Identifier => Ptr_Id, + Type_Definition => + Make_Access_To_Object_Definition (Loc, + All_Present => + Ekind (Obj_Typ) = E_General_Access_Type, + Subtype_Indication => + New_Reference_To (Desig_Typ, Loc))); + + -- Step 2: Create a temporary which acts as a hook to + -- the transient object. Generate: + + -- Temp : Ptr_Id := null; + + Temp_Id := Make_Temporary (Loc, 'T'); + + Temp_Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Temp_Id, + Object_Definition => + New_Reference_To (Ptr_Id, Loc)); + + -- Analyze the access type and the hook declarations + + Prepend_To (Ins_List, Temp_Decl); + Prepend_To (Ins_List, Ptr_Decl); + + Analyze (Ptr_Decl); + Analyze (Temp_Decl); + + -- Mark the temporary as a transient hook. This signals + -- the machinery in Build_Finalizer to recognize this + -- special case. + + Set_Return_Flag_Or_Transient_Decl (Temp_Id, Stmt); + + -- Step 3: Hook the transient object to the temporary + + if Is_Access_Type (Obj_Typ) then + Expr := + Convert_To (Ptr_Id, New_Reference_To (Obj_Id, Loc)); + else + Expr := + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Obj_Id, Loc), + Attribute_Name => Name_Unrestricted_Access); + end if; + + -- Generate: + -- Temp := Ptr_Id (Obj_Id); + -- + -- Temp := Obj_Id'Unrestricted_Access; + + Insert_After_And_Analyze (Stmt, + Make_Assignment_Statement (Loc, + Name => New_Reference_To (Temp_Id, Loc), + Expression => Expr)); + end; + end if; + + Stmts := New_List; + + -- The transient object is about to be finalized by the clean + -- up code following the subprogram call. In order to avoid + -- double finalization, clear the hook. + + -- Generate: + -- Temp := null; + + if Requires_Hooking then + Append_To (Stmts, + Make_Assignment_Statement (Loc, + Name => New_Reference_To (Temp_Id, Loc), + Expression => Make_Null (Loc))); + end if; + + -- Generate: + -- [Deep_]Finalize (Obj_Ref); + + Obj_Ref := New_Reference_To (Obj_Id, Loc); + + if Is_Access_Type (Obj_Typ) then + Obj_Ref := Make_Explicit_Dereference (Loc, Obj_Ref); + end if; + + Append_To (Stmts, + Make_Final_Call + (Obj_Ref => Obj_Ref, + Typ => Desig_Typ)); + -- Generate: + -- [Temp := null;] -- begin -- [Deep_]Finalize (Obj_Ref); @@ -4264,23 +4415,14 @@ package body Exp_Ch7 is -- end if; -- end; - Obj_Ref := New_Reference_To (Obj_Id, Loc); - - if Is_Access_Type (Obj_Typ) then - Obj_Ref := Make_Explicit_Dereference (Loc, Obj_Ref); - end if; - Fin_Block := Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Make_Final_Call - (Obj_Ref => Obj_Ref, - Typ => Desig)), - + Statements => Stmts, Exception_Handlers => New_List ( - Build_Exception_Handler (Finalizer_Data)))); + Build_Exception_Handler (Fin_Data)))); + Insert_After_And_Analyze (Last_Object, Fin_Block); -- The raise statement must be inserted after all the @@ -4345,7 +4487,7 @@ package body Exp_Ch7 is and then Present (Last_Fin) then Insert_After_And_Analyze (Last_Fin, - Build_Raise_Statement (Finalizer_Data)); + Build_Raise_Statement (Fin_Data)); end if; end Process_Transient_Objects; -- 2.30.2