From: charlet Date: Mon, 5 Sep 2011 13:19:04 +0000 (+0000) Subject: 2011-09-05 Hristian Kirtchev X-Git-Tag: upstream/4.9.2~17929 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=3b21faf24a610d641bb769610db10a6f56502640;p=platform%2Fupstream%2Flinaro-gcc.git 2011-09-05 Hristian Kirtchev * einfo.adb (Write_Field28_Name): Update the choices for Extra_Formals. * einfo.ads: Update the use of Extra_Formals in various entities. * exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): Code reformatting. Handle the case where the function call returns an incomplete type coming from a limited with context. Generate a reference to the _master when the master id is associated with an access type. (Is_Build_In_Place_Function_Call): Code reformatting. The Alfa mode case must appear first since otherwise we will carry out the function name retrieval regardless of the compilation mode. (Make_Build_In_Place_Call_In_Allocator): Code reformatting. Handle the case where the function call returns an incomplete type coming from a limited with context. Remove the reference creation when adding the task-related actuals, this is now done in Add_Task_Actuals_To_Build_In_Place_Call. * exp_ch7.adb (Make_Set_Finalize_Address_Call): Remove local variable Call. Remove the useless wrapping of Set_Finalize_Address when the finalization master is a build-in-place extra formal. The whole mechanism of controlled allocation in a build-in-place context is already protected by an if statement. * sem_aux.adb (Is_Immutably_Limited_Type): Handle the case where the type might be related to a function which returns an incomplete type coming from a limited with. * sem_ch6.adb (Create_Extra_Formals): Comment reformatting. Handle the case where the function returns an incomplete type coming from a limited with context. 2011-09-05 Johannes Kanig * lib-xref-alfa.adb (Is_Alfa_Reference): Improve test for constant objects and rewrite case statement as /if/elsif/endif. 2011-09-05 Thomas Quinot * sem_ch3.adb, sem_ch4.adb: Minor reformatting. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178537 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 494f31b..d88ff56 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -8686,9 +8686,12 @@ package body Einfo is procedure Write_Field28_Name (Id : Entity_Id) is begin case Ekind (Id) is - when E_Procedure | + when E_Entry | + E_Entry_Family | E_Function | - E_Entry => + E_Procedure | + E_Subprogram_Body | + E_Subprogram_Type => Write_Str ("Extra_Formals"); when E_Record_Type => diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c0dda86..bfbe2f8 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -5137,6 +5137,7 @@ package Einfo is -- Protection_Object (Node23) (protected kind) -- Contract (Node24) (for entry only) -- PPC_Wrapper (Node25) + -- Extra_Formals (Node28) -- Default_Expressions_Processed (Flag108) -- Entry_Accepted (Flag152) -- Is_AST_Entry (Flag132) (for entry only) @@ -5670,10 +5671,12 @@ package Einfo is -- Corresponding_Protected_Entry (Node18) -- Last_Entity (Node20) -- Scope_Depth_Value (Uint22) + -- Extra_Formals (Node28) -- Scope_Depth (synth) -- E_Subprogram_Type -- Directly_Designated_Type (Node20) + -- Extra_Formals (Node28) -- First_Formal (synth) -- First_Formal_With_Extras (synth) -- Last_Formal (synth) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 75d06c5..e8e46e1 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -469,7 +469,7 @@ package body Exp_Ch6 is begin -- No such extra parameters are needed if there are no tasks - if not Has_Task (Etype (Function_Id)) then + if not Has_Task (Available_View (Etype (Function_Id))) then return; end if; @@ -477,6 +477,12 @@ package body Exp_Ch6 is if Restriction_Active (No_Task_Hierarchy) then Actual := New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc); + + -- In the case where we use the master associated with an access type, + -- the actual is an entity and requires an explicit reference. + + elsif Nkind (Actual) = N_Defining_Identifier then + Actual := New_Reference_To (Actual, Loc); end if; -- The master @@ -493,8 +499,7 @@ package body Exp_Ch6 is -- Build the parameter association for the new actual and add it to -- the end of the function's actuals. - Add_Extra_Actual_To_Call - (Function_Call, Master_Formal, Actual); + Add_Extra_Actual_To_Call (Function_Call, Master_Formal, Actual); end; -- The activation chain @@ -506,8 +511,8 @@ package body Exp_Ch6 is begin -- Locate implicit activation chain parameter in the called function - Activation_Chain_Formal := Build_In_Place_Formal - (Function_Id, BIP_Activation_Chain); + Activation_Chain_Formal := + Build_In_Place_Formal (Function_Id, BIP_Activation_Chain); -- Create the actual which is a pointer to the current activation -- chain @@ -6814,8 +6819,8 @@ package body Exp_Ch6 is -- Step past qualification or unchecked conversion (the latter can occur -- in cases of calls to 'Input). - if Nkind_In - (Exp_Node, N_Qualified_Expression, N_Unchecked_Type_Conversion) + if Nkind_In (Exp_Node, N_Qualified_Expression, + N_Unchecked_Type_Conversion) then Exp_Node := Expression (N); end if; @@ -6824,19 +6829,22 @@ package body Exp_Ch6 is return False; else - if Is_Entity_Name (Name (Exp_Node)) then + -- In Alfa mode, build-in-place calls are not expanded, so that we + -- may end up with a call that is neither resolved to an entity, nor + -- an indirect call. + + if Alfa_Mode then + return False; + + elsif Is_Entity_Name (Name (Exp_Node)) then Function_Id := Entity (Name (Exp_Node)); + -- In the case of an explicitly dereferenced call, use the subprogram + -- type generated for the dereference. + elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then Function_Id := Etype (Name (Exp_Node)); - -- In Alfa mode, protected subprogram calls are not expanded, so that - -- we may end up with a call that is neither resolved to an entity, - -- nor an indirect call. - - elsif Alfa_Mode then - return False; - else raise Program_Error; end if; @@ -7092,11 +7100,11 @@ package body Exp_Ch6 is (Allocator : Node_Id; Function_Call : Node_Id) is + Acc_Type : constant Entity_Id := Etype (Allocator); Loc : Source_Ptr; Func_Call : Node_Id := Function_Call; Function_Id : Entity_Id; Result_Subt : Entity_Id; - Acc_Type : constant Entity_Id := Etype (Allocator); New_Allocator : Node_Id; Return_Obj_Access : Entity_Id; @@ -7135,7 +7143,7 @@ package body Exp_Ch6 is raise Program_Error; end if; - Result_Subt := Etype (Function_Id); + Result_Subt := Available_View (Etype (Function_Id)); -- Check whether return type includes tasks. This may not have been done -- previously, if the type was a limited view. @@ -7236,17 +7244,8 @@ package body Exp_Ch6 is Add_Finalization_Master_Actual_To_Build_In_Place_Call (Func_Call, Function_Id, Acc_Type); - -- If access type has a master entity, pass a reference to it - - if Present (Master_Id (Acc_Type)) then - Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, - Master_Actual => - New_Occurrence_Of (Master_Id (Acc_Type), Loc)); - else - Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Empty); - end if; + Add_Task_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, Master_Actual => Master_Id (Acc_Type)); -- The caller does not provide the return object in this case, so we -- have to pass null for the object access actual. diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index f36e29e..3a4b07d 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -7461,7 +7461,6 @@ package body Exp_Ch7 is Desig_Typ : constant Entity_Id := Available_View (Designated_Type (Ptr_Typ)); Fin_Mas_Id : constant Entity_Id := Finalization_Master (Ptr_Typ); - Call : Node_Id; Fin_Mas_Ref : Node_Id; Utyp : Entity_Id; @@ -7526,7 +7525,7 @@ package body Exp_Ch7 is -- Generate: -- Set_Finalize_Address (FM, FD'Unrestricted_Access); - Call := + return Make_Procedure_Call_Statement (Loc, Name => New_Reference_To (RTE (RE_Set_Finalize_Address), Loc), @@ -7536,25 +7535,6 @@ package body Exp_Ch7 is Prefix => New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc), Attribute_Name => Name_Unrestricted_Access))); - - -- In the case of build-in-place functions, protect the call to ensure - -- we have a master at run time. Generate: - - -- if FM /= null then - -- ; - -- end if; - - if Is_Access_Type (Etype (Fin_Mas_Id)) then - Call := - Make_If_Statement (Loc, - Condition => - Make_Op_Ne (Loc, - Left_Opnd => New_Reference_To (Fin_Mas_Id, Loc), - Right_Opnd => Make_Null (Loc)), - Then_Statements => New_List (Call)); - end if; - - return Call; end Make_Set_Finalize_Address_Call; -------------------------- diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index 9e154fd..8eef505 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -604,38 +604,36 @@ package body Alfa is Typ : Character) return Boolean is begin - -- The only references of interest on callable entities are calls. - -- On non-callable entities, the only references of interest are - -- reads and writes. - case Ekind (E) is - when Overloadable_Kind => - return Typ = 's'; + if Ekind (E) in Overloadable_Kind then - -- References to IN parameters and constants are not - -- considered in Alfa section, as these will be translated - -- as constants in the intermediate language for formal - -- verification, and should therefore never appear in frame - -- conditions. + -- The only references of interest on callable entities are + -- calls. On non-callable entities, the only references of + -- interest are reads and writes. - -- What about E_Loop_Parameter??? + return Typ = 's'; + + elsif Is_Constant_Object (E) then + + -- References to constant objects are not considered in Alfa + -- section, as these will be translated as constants in the + -- intermediate language for formal verification, and should + -- therefore never appear in frame conditions. - when E_In_Parameter | E_Constant => return False; - when others => + elsif Present (Etype (E)) and then + Ekind (Etype (E)) in Concurrent_Kind then - -- Objects of Task type or protected type are not Alfa - -- references. + -- Objects of Task type or protected type are not Alfa + -- references. - if Present (Etype (E)) - and then Ekind (Etype (E)) in Concurrent_Kind - then - return False; - end if; + return False; - return Typ = 'r' or else Typ = 'm'; - end case; + else + return Typ = 'r' or else Typ = 'm'; + + end if; end Is_Alfa_Reference; ------------------- diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 974ff1d..3b3453f 100755 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -597,7 +597,7 @@ package body Sem_Aux is ------------------------------- function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean is - Btype : constant Entity_Id := Base_Type (Ent); + Btype : constant Entity_Id := Available_View (Base_Type (Ent)); begin if Is_Limited_Record (Btype) then @@ -607,9 +607,8 @@ package body Sem_Aux is and then Nkind (Parent (Btype)) = N_Formal_Type_Declaration then return not In_Package_Body (Scope ((Btype))); - end if; - if Is_Private_Type (Btype) then + elsif Is_Private_Type (Btype) then -- AI05-0063: A type derived from a limited private formal type is -- not immutably limited in a generic body. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 9d9e62c..46abaa9 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15061,6 +15061,7 @@ package body Sem_Ch3 is Tag_Mismatch; end if; end if; + if Present (Prev) and then Nkind (Parent (Prev)) = N_Incomplete_Type_Declaration and then Present (Premature_Use (Parent (Prev))) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 6c886d5..8bdc569 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4322,7 +4322,7 @@ package body Sem_Ch4 is Error_Msg_Node_2 := First_Subtype (Prefix_Type); Error_Msg_NE ("no selector& for}", N, Sel); - -- If prefix is incomplete, add information + -- Add information in the case of an incomplete prefix if Is_Incomplete_Type (Type_To_Use) then declare @@ -4340,6 +4340,10 @@ package body Sem_Ch4 is if Nkind (Parent (Inc)) = N_Incomplete_Type_Declaration then + -- Record location of premature use in entity so that + -- a continuation message is generated when the + -- completion is seen. + Set_Premature_Use (Parent (Inc), N); end if; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index b978874..b701bda 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6371,11 +6371,11 @@ package body Sem_Ch6 is E, BIP_Formal_Suffix (BIP_Finalization_Master)); end if; - -- If the result type contains tasks, we have two extra formals: - -- the master of the tasks to be created, and the caller's - -- activation chain. + -- When the result type contains tasks, add two extra formals: the + -- master of the tasks to be created, and the caller's activation + -- chain. - if Has_Task (Result_Subt) then + if Has_Task (Available_View (Result_Subt)) then Discard := Add_Extra_Formal (E, RTE (RE_Master_Id),