From: Arnaud Charlet Date: Thu, 16 Jun 2016 10:25:47 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3386e3ae5dcea06e710c0bccdc2af72b1ab8dde4;p=gcc.git [multiple changes] 2016-06-16 Ed Schonberg * sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary of Analyze_Declarations, that performs pre-analysis of pre/postconditions on entry declarations before full analysis is performed after entries have been converted into procedures. Done solely to capture semantic errors. * sem_attr.adb (Analyze_Attribute, case 'Result): Add guard to call to Denote_Same_Function. 2016-06-16 Emmanuel Briot * g-comlin.adb: Fix minor memory leak in GNAT.Command_Line. 2016-06-16 Hristian Kirtchev * exp_ch7.adb (Find_Last_Init): Remove obsolete code. The logic is now performed by Process_Object_Declaration. (Process_Declarations): Recognize a controlled deferred constant which is in fact initialized by means of a build-in-place function call as needing finalization actions. (Process_Object_Declaration): Insert the counter after the build-in-place initialization call for a controlled object. This was previously done in Find_Last_Init. * exp_util.adb (Requires_Cleanup_Actions): Recognize a controlled deferred constant which is in fact initialized by means of a build-in-place function call as needing finalization actions. 2016-06-16 Justin Squirek * exp_aggr.adb (Expand_Array_Aggregate): Minor comment changes and additional style fixes. * exp_ch7.adb: Minor typo fixes and reformatting. From-SVN: r237515 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dc34b75a7e4..5f24e357f25 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2016-06-16 Ed Schonberg + + * sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary + of Analyze_Declarations, that performs pre-analysis of + pre/postconditions on entry declarations before full analysis + is performed after entries have been converted into procedures. + Done solely to capture semantic errors. + * sem_attr.adb (Analyze_Attribute, case 'Result): Add guard to + call to Denote_Same_Function. + +2016-06-16 Emmanuel Briot + + * g-comlin.adb: Fix minor memory leak in GNAT.Command_Line. + +2016-06-16 Hristian Kirtchev + + * exp_ch7.adb (Find_Last_Init): Remove obsolete code. The + logic is now performed by Process_Object_Declaration. + (Process_Declarations): Recognize a controlled deferred + constant which is in fact initialized by means of a + build-in-place function call as needing finalization actions. + (Process_Object_Declaration): Insert the counter after the + build-in-place initialization call for a controlled object. This + was previously done in Find_Last_Init. + * exp_util.adb (Requires_Cleanup_Actions): Recognize a controlled + deferred constant which is in fact initialized by means of a + build-in-place function call as needing finalization actions. + +2016-06-16 Justin Squirek + + * exp_aggr.adb (Expand_Array_Aggregate): Minor comment changes and + additional style fixes. + * exp_ch7.adb: Minor typo fixes and reformatting. + 2016-06-16 Justin Squirek * sem_ch3.adb (Analyze_Object_Declaration): Add a missing check diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index c75cafc778a..c3949dfa7f0 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5517,20 +5517,21 @@ package body Exp_Aggr is -- object. (Note: we don't use a block statement because this would -- cause generated freeze nodes to be elaborated in the wrong scope). - -- Should document these individual tests ??? + -- Do not perform in-place expansion for SPARK 05 because aggregates are + -- expected to appear in qualified form. In-place expansion eliminates + -- the qualification and eventually violates this SPARK 05 restiction. - if not Has_Default_Init_Comps (N) - and then Comes_From_Source (Parent_Node) - and then Parent_Kind = N_Object_Declaration - and then not - Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ) - and then Present (Expression (Parent_Node)) - and then not Has_Controlled_Component (Typ) - and then not Is_Bit_Packed_Array (Typ) - - -- ??? the test for SPARK 05 needs documentation + -- Should document the rest of the guards ??? - and then not Restriction_Check_Required (SPARK_05) + if not Has_Default_Init_Comps (N) + and then Comes_From_Source (Parent_Node) + and then Parent_Kind = N_Object_Declaration + and then Present (Expression (Parent_Node)) + and then not + Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ) + and then not Has_Controlled_Component (Typ) + and then not Is_Bit_Packed_Array (Typ) + and then not Restriction_Check_Required (SPARK_05) then In_Place_Assign_OK_For_Declaration := True; Tmp := Defining_Identifier (Parent_Node); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index a166b80b12a..d6c17372385 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2100,16 +2100,21 @@ package body Exp_Ch7 is null; -- The object is of the form: - -- Obj : Typ [:= Expr]; + -- Obj : [constant] Typ [:= Expr]; - -- Do not process the incomplete view of a deferred constant. - -- Do not consider tag-to-class-wide conversions. + -- Do not process tag-to-class-wide conversions because they do + -- not yield an object. Do not process the incomplete view of a + -- deferred constant. Note that an object initialized by means + -- of a build-in-place function call may appear as a deferred + -- constant after expansion activities. These kinds of objects + -- must be finalized. elsif not Is_Imported (Obj_Id) and then Needs_Finalization (Obj_Typ) - and then not (Ekind (Obj_Id) = E_Constant - and then not Has_Completion (Obj_Id)) and then not Is_Tag_To_Class_Wide_Conversion (Obj_Id) + and then not (Ekind (Obj_Id) = E_Constant + and then not Has_Completion (Obj_Id) + and then No (BIP_Initialization_Call (Obj_Id))) then Processing_Actions; @@ -2757,48 +2762,9 @@ package body Exp_Ch7 is Stmt := Next_Suitable_Statement (Decl); - -- A limited controlled object initialized by a function call uses - -- the build-in-place machinery to obtain its value. - - -- Obj : Lim_Controlled_Type := Func_Call; - - -- is expanded into - - -- Obj : Lim_Controlled_Type; - -- type Ptr_Typ is access Lim_Controlled_Type; - -- Temp : constant Ptr_Typ := - -- Func_Call - -- (BIPalloc => 1, - -- BIPaccess => Obj'Unrestricted_Access)'reference; - - -- In this scenario the declaration of the temporary acts as the - -- last initialization statement. - - if Is_Limited_Type (Obj_Typ) - and then Has_Init_Expression (Decl) - and then No (Expression (Decl)) - then - while Present (Stmt) loop - if Nkind (Stmt) = N_Object_Declaration - and then Present (Expression (Stmt)) - and then Is_Object_Access_BIP_Func_Call - (Expr => Expression (Stmt), - Obj_Id => Obj_Id) - then - Last_Init := Stmt; - exit; - end if; - - Next (Stmt); - end loop; - - -- Nothing to do for an object with supporessed initialization. - -- Note that this check is not performed at the beginning of the - -- routine because a declaration marked with No_Initialization - -- may still be initialized by a build-in-place call (the case - -- above). + -- Nothing to do for an object with suppressed initialization - elsif No_Initialization (Decl) then + if No_Initialization (Decl) then return; -- In all other cases the initialization calls follow the related @@ -2937,18 +2903,33 @@ package body Exp_Ch7 is Expression => Make_Integer_Literal (Loc, Counter_Val)); -- Insert the counter after all initialization has been done. The - -- place of insertion depends on the context. If an object is being - -- initialized via an aggregate, then the counter must be inserted - -- after the last aggregate assignment. + -- place of insertion depends on the context. - if Ekind_In (Obj_Id, E_Constant, E_Variable) - and then Present (Last_Aggregate_Assignment (Obj_Id)) - then - Count_Ins := Last_Aggregate_Assignment (Obj_Id); - Body_Ins := Empty; + if Ekind_In (Obj_Id, E_Constant, E_Variable) then + + -- The object is initialized by a build-in-place function call. + -- The counter insertion point is after the function call. + + if Present (BIP_Initialization_Call (Obj_Id)) then + Count_Ins := BIP_Initialization_Call (Obj_Id); + Body_Ins := Empty; + + -- The object is initialized by an aggregate. Insert the counter + -- after the last aggregate assignment. + + elsif Present (Last_Aggregate_Assignment (Obj_Id)) then + Count_Ins := Last_Aggregate_Assignment (Obj_Id); + Body_Ins := Empty; + + -- In all other cases the counter is inserted after the last call + -- to either [Deep_]Initialize or the type-specific init proc. + + else + Find_Last_Init (Count_Ins, Body_Ins); + end if; -- In all other cases the counter is inserted after the last call to - -- either [Deep_]Initialize or the type specific init proc. + -- either [Deep_]Initialize or the type-specific init proc. else Find_Last_Init (Count_Ins, Body_Ins); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 77fd7e192f0..fcd16a26cb0 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2948,10 +2948,9 @@ package body Exp_Util is N_Discriminant_Association, N_Parameter_Association, N_Pragma_Argument_Association) - and then not Nkind_In - (Parent (Par), N_Function_Call, - N_Procedure_Call_Statement, - N_Entry_Call_Statement) + and then not Nkind_In (Parent (Par), N_Function_Call, + N_Procedure_Call_Statement, + N_Entry_Call_Statement) then return Par; @@ -8279,16 +8278,21 @@ package body Exp_Util is return False; -- The object is of the form: - -- Obj : Typ [:= Expr]; + -- Obj : [constant] Typ [:= Expr]; -- - -- Do not process the incomplete view of a deferred constant. Do - -- not consider tag-to-class-wide conversions. + -- Do not process tag-to-class-wide conversions because they do + -- not yield an object. Do not process the incomplete view of a + -- deferred constant. Note that an object initialized by means + -- of a build-in-place function call may appear as a deferred + -- constant after expansion activities. These kinds of objects + -- must be finalized. elsif not Is_Imported (Obj_Id) and then Needs_Finalization (Obj_Typ) - and then not (Ekind (Obj_Id) = E_Constant - and then not Has_Completion (Obj_Id)) and then not Is_Tag_To_Class_Wide_Conversion (Obj_Id) + and then not (Ekind (Obj_Id) = E_Constant + and then not Has_Completion (Obj_Id) + and then No (BIP_Initialization_Call (Obj_Id))) then return True; diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index 172edaf889b..86ac2b59881 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -3073,6 +3073,7 @@ package body GNAT.Command_Line is Free (Config.Switches (S).Long_Switch); Free (Config.Switches (S).Help); Free (Config.Switches (S).Section); + Free (Config.Switches (S).Argument); end loop; Unchecked_Free (Config.Switches); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f1535179c1b..eefeabe63d6 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5348,7 +5348,9 @@ package body Sem_Attr is if Is_Entity_Name (P) then Pref_Id := Entity (P); - if Ekind_In (Pref_Id, E_Function, E_Generic_Function) then + if Ekind_In (Pref_Id, E_Function, E_Generic_Function) + and then Ekind (Spec_Id) = Ekind (Pref_Id) + then if Denote_Same_Function (Pref_Id, Spec_Id) then -- Correct the prefix of the attribute when the context diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 22b4721d552..6a72f2839e1 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2165,6 +2165,13 @@ package body Sem_Ch3 is -- (They have the sloc of the label as found in the source, and that -- is ahead of the current declarative part). + procedure Check_Entry_Contracts; + -- Perform a pre-analysis of the pre- and postconditions of an entry + -- declaration. This must be done before full resolution and creation + -- of the parameter block, etc. to catch illegal uses within the + -- contract expression. Full analysis of the expression is done when + -- the contract is processed. + procedure Handle_Late_Controlled_Primitive (Body_Decl : Node_Id); -- Determine whether Body_Decl denotes the body of a late controlled -- primitive (either Initialize, Adjust or Finalize). If this is the @@ -2189,6 +2196,56 @@ package body Sem_Ch3 is end loop; end Adjust_Decl; + --------------------------- + -- Check_Entry_Contracts -- + --------------------------- + + procedure Check_Entry_Contracts is + ASN : Node_Id; + Ent : Entity_Id; + Exp : Node_Id; + + begin + Ent := First_Entity (Current_Scope); + while Present (Ent) loop + + -- This only concerns entries with pre/postconditions + + if Ekind (Ent) = E_Entry + and then Present (Contract (Ent)) + and then Present (Pre_Post_Conditions (Contract (Ent))) + then + ASN := Pre_Post_Conditions (Contract (Ent)); + Push_Scope (Ent); + Install_Formals (Ent); + + -- Pre/postconditions are rewritten as Check pragmas. Analysis + -- is performed on a copy of the pragma expression, to prevent + -- modifying the original expression. + + while Present (ASN) loop + if Nkind (ASN) = N_Pragma then + Exp := + New_Copy_Tree + (Expression + (First (Pragma_Argument_Associations (ASN)))); + Set_Parent (Exp, ASN); + + -- ??? why not Preanalyze_Assert_Expression + + Preanalyze (Exp); + end if; + + ASN := Next_Pragma (ASN); + end loop; + + End_Scope; + end if; + + Next_Entity (Ent); + end loop; + end Check_Entry_Contracts; + -------------------------------------- -- Handle_Late_Controlled_Primitive -- -------------------------------------- @@ -2349,12 +2406,14 @@ package body Sem_Ch3 is -- (This is needed in any case for early instantiations ???). if No (Next_Decl) then - if Nkind_In (Parent (L), N_Component_List, - N_Task_Definition, - N_Protected_Definition) - then + if Nkind (Parent (L)) = N_Component_List then null; + elsif Nkind_In (Parent (L), N_Protected_Definition, + N_Task_Definition) + then + Check_Entry_Contracts; + elsif Nkind (Parent (L)) /= N_Package_Specification then if Nkind (Parent (L)) = N_Package_Body then Freeze_From := First_Entity (Current_Scope);