From: Ed Schonberg Date: Mon, 4 Aug 2008 18:50:45 +0000 (+0200) Subject: 2008-08-04 Ed Schonberg X-Git-Tag: releases/gcc-4.4.0~3392 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=cd1c668b50e5fa0041d6d6267e884914e0aa9d94;p=thirdparty%2Fgcc.git 2008-08-04 Ed Schonberg * sem_ch3.adb: (Replace_Anonymous_Access_To_Protected_Subprogram): Handle properly an anonymous access to protected subprogram that is the return type of the specification of a subprogram body. * sem_ch6.adb: (Analyze_Subprogram_Body): if the return type is an anonymous access to subprogram, freeze it now to prevent access anomalies in the back-end. * exp_ch9.adb: Minor code cleanup. Make sure that new declarations are inserted into the tree before analysis (from code reading). From-SVN: r138650 --- diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 2a91413d5701..53de7a0e9d5c 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -4733,9 +4733,9 @@ package body Exp_Ch9 is Def1 : Node_Id; begin - -- Create access to protected subprogram with full signature + -- Create access to subprogram with full signature - if Nkind (Type_Definition (N)) = N_Access_Function_Definition then + if Etype (D_T) /= Standard_Void_Type then Def1 := Make_Access_Function_Definition (Loc, Parameter_Specifications => P_List, @@ -4753,8 +4753,8 @@ package body Exp_Ch9 is Defining_Identifier => D_T2, Type_Definition => Def1); - Analyze (Decl1); Insert_After (N, Decl1); + Analyze (Decl1); -- Create Equivalent_Type, a record with two components for an access to -- object and an access to subprogram. @@ -4786,8 +4786,8 @@ package body Exp_Ch9 is Make_Component_List (Loc, Component_Items => Comps))); - Analyze (Decl2); Insert_After (Decl1, Decl2); + Analyze (Decl2); Set_Equivalent_Type (T, E_T); end Expand_Access_Protected_Subprogram_Type; @@ -7062,6 +7062,7 @@ package body Exp_Ch9 is procedure Expand_N_Protected_Body (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); Pid : constant Entity_Id := Corresponding_Spec (N); + Current_Node : Node_Id; Disp_Op_Body : Node_Id; New_Op_Body : Node_Id; @@ -7070,6 +7071,9 @@ package body Exp_Ch9 is Op_Decl : Node_Id; Op_Id : Entity_Id; + Chain : Entity_Id := Empty; + -- Finalization chain that may be attached to new body + function Build_Dispatching_Subprogram_Body (N : Node_Id; Pid : Node_Id; @@ -7203,13 +7207,13 @@ package body Exp_Ch9 is -- entity is not further elaborated, and so the chain -- properly belongs to the newly created subprogram body. - if Present - (Finalization_Chain_Entity (Defining_Entity (Op_Body))) - then + Chain := + Finalization_Chain_Entity (Defining_Entity (Op_Body)); + + if Present (Chain) then Set_Finalization_Chain_Entity (Protected_Body_Subprogram - (Corresponding_Spec (Op_Body)), - Finalization_Chain_Entity (Defining_Entity (Op_Body))); + (Corresponding_Spec (Op_Body)), Chain); Set_Analyzed (Handled_Statement_Sequence (New_Op_Body), False); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 307b6a158b6c..44cd6c65e035 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1056,7 +1056,6 @@ package body Sem_Ch3 is N_Object_Renaming_Declaration, N_Formal_Object_Declaration, N_Formal_Type_Declaration, - N_Formal_Object_Declaration, N_Task_Type_Declaration, N_Protected_Type_Declaration)) loop @@ -4476,9 +4475,17 @@ package body Sem_Ch3 is Mark_Rewrite_Insertion (Decl); - -- Insert the new declaration in the nearest enclosing scope + -- Insert the new declaration in the nearest enclosing scope. If the + -- node is a body and N is its return type, the declaration belongs in + -- the enclosing scope. P := Parent (N); + if Nkind (P) = N_Subprogram_Body + and then Nkind (N) = N_Function_Specification + then + P := Parent (P); + end if; + while Present (P) and then not Has_Declarations (P) loop P := Parent (P); end loop; @@ -4521,13 +4528,13 @@ package body Sem_Ch3 is Mark_Rewrite_Insertion (Comp); - -- Temporarily remove the current scope from the stack to add the new - -- declarations to the enclosing scope - if Nkind_In (N, N_Object_Declaration, N_Access_Function_Definition) then Analyze (Decl); else + -- Temporarily remove the current scope (record or subprogram) from + -- the stack to add the new declarations to the enclosing scope. + Scope_Stack.Decrement_Last; Analyze (Decl); Set_Is_Itype (Anon); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index ea1a21ed1781..1e84b266745f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -663,9 +663,9 @@ package body Sem_Ch6 is -- Analyze_Object_Declaration; we treat it as a normal -- object declaration. + Set_Is_Return_Object (Defining_Identifier (Obj_Decl)); Analyze (Obj_Decl); - Set_Is_Return_Object (Defining_Identifier (Obj_Decl)); Check_Return_Subtype_Indication (Obj_Decl); if Present (HSS) then @@ -1804,12 +1804,19 @@ package body Sem_Ch6 is -- the body that depends on the subprogram having been frozen, -- such as uses of extra formals), so we force it to be frozen -- here. Same holds if the body and spec are compilation units. + -- Finally, if the return type is an anonymous access to protected + -- subprogram, it must be frozen before the body because its + -- expansion has generated an equivalent type that is used when + -- elaborating the body. if No (Spec_Id) then Freeze_Before (N, Body_Id); elsif Nkind (Parent (N)) = N_Compilation_Unit then Freeze_Before (N, Spec_Id); + + elsif Is_Access_Subprogram_Type (Etype (Body_Id)) then + Freeze_Before (N, Etype (Body_Id)); end if; else