diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 26b488a0809..e0af917758d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2016-06-14 Javier Miranda + + * sem_attr.adb (Analyze_Attribute_Old_Result): Adding assertion. + (Analyze_Attribute [Attribute_Old]): Generating C handle + analysis of 'old in inlined postconditions. + (Analyze_Attribute [Attribute_Result]): Generating C handle analysis + of 'result in inlined postconditions. + * exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Old]): + Generating C handle expansion of 'old in inlined postconditions. + * inline.adb (Declare_Postconditions_Result): New subprogram. + * sem_ch12.adb (Copy_Generic_Node): Copy pragmas generated from + aspects when generating C code since pre/post conditions are + inlined and the frontend inlining relies on this routine to + perform inlining. + * exp_ch6.adb (Inlined_Subprogram): Replace Generate_C_Code + by Modify_Tree_For_C. + * exp_unst.adb (Visit_Node): Searching for up-level references + skip entities defined in inlined subprograms. + 2016-06-14 Hristian Kirtchev * sem_ch7.adb, sem_ch12.adb, freeze.adb, lib-xref.ads, exp_ch3.adb: diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 30bcc9e98a2..4907c66d9e9 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -4357,10 +4357,24 @@ package body Exp_Attr is Typ : constant Entity_Id := Etype (N); CW_Temp : Entity_Id; CW_Typ : Entity_Id; + Ins_Nod : Node_Id; Subp : Node_Id; Temp : Entity_Id; begin + -- Generating C code we don't need to expand this attribute when + -- we are analyzing the internally built nested postconditions + -- procedure since it will be expanded inline (and later it will + -- be removed by Expand_N_Subprogram_Body). It this expansion is + -- performed in such case then the compiler generates unreferenced + -- extra temporaries. + + if Modify_Tree_For_C + and then Chars (Current_Scope) = Name_uPostconditions + then + return; + end if; + -- Climb the parent chain looking for subprogram _Postconditions Subp := N; @@ -4381,9 +4395,11 @@ package body Exp_Attr is end loop; -- 'Old can only appear in a postcondition, the generated body of - -- _Postconditions must be in the tree. + -- _Postconditions must be in the tree (or inlined if we are + -- generating C code). - pragma Assert (Present (Subp)); + pragma Assert (Present (Subp) + or else (Modify_Tree_For_C and then In_Inlined_Body)); Temp := Make_Temporary (Loc, 'T', Pref); @@ -4397,7 +4413,35 @@ package body Exp_Attr is -- resides as this ensures that the object will be analyzed in the -- proper context. - Push_Scope (Scope (Defining_Entity (Subp))); + if Present (Subp) then + Push_Scope (Scope (Defining_Entity (Subp))); + + -- No need to push the scope when generating C code since the + -- _Postcondition procedure has been inlined. + + else pragma Assert (Modify_Tree_For_C); + pragma Assert (In_Inlined_Body); + null; + end if; + + -- Locate the insertion place of the internal temporary that saves + -- the 'Old value. + + if Present (Subp) then + Ins_Nod := Subp; + + -- Generating C, the postcondition procedure has been inlined and the + -- temporary is added before the first declaration of the enclosing + -- subprogram. + + else pragma Assert (Modify_Tree_For_C); + Ins_Nod := N; + while Nkind (Ins_Nod) /= N_Subprogram_Body loop + Ins_Nod := Parent (Ins_Nod); + end loop; + + Ins_Nod := First (Declarations (Ins_Nod)); + end if; -- Preserve the tag of the prefix by offering a specific view of the -- class-wide version of the prefix. @@ -4410,7 +4454,7 @@ package body Exp_Attr is CW_Temp := Make_Temporary (Loc, 'T'); CW_Typ := Class_Wide_Type (Typ); - Insert_Before_And_Analyze (Subp, + Insert_Before_And_Analyze (Ins_Nod, Make_Object_Declaration (Loc, Defining_Identifier => CW_Temp, Constant_Present => True, @@ -4421,7 +4465,7 @@ package body Exp_Attr is -- Generate: -- Temp : Typ renames Typ (CW_Temp); - Insert_Before_And_Analyze (Subp, + Insert_Before_And_Analyze (Ins_Nod, Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Temp, Subtype_Mark => New_Occurrence_Of (Typ, Loc), @@ -4434,7 +4478,7 @@ package body Exp_Attr is -- Generate: -- Temp : constant Typ := Pref; - Insert_Before_And_Analyze (Subp, + Insert_Before_And_Analyze (Ins_Nod, Make_Object_Declaration (Loc, Defining_Identifier => Temp, Constant_Present => True, @@ -4442,7 +4486,9 @@ package body Exp_Attr is Expression => Relocate_Node (Pref))); end if; - Pop_Scope; + if Present (Subp) then + Pop_Scope; + end if; -- Ensure that the prefix of attribute 'Old is valid. The check must -- be inserted after the expansion of the attribute has taken place diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 9f7c1dc01c6..f481fa954df 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -3919,7 +3919,7 @@ package body Exp_Ch6 is -- Inline calls to _postconditions when generating C code - elsif Generate_C_Code + elsif Modify_Tree_For_C and then In_Same_Extended_Unit (Sloc (Bod), Loc) and then Chars (Name (N)) = Name_uPostconditions then diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 302cc100834..a3e433fedb8 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -636,6 +636,10 @@ package body Exp_Unst is if not Is_Library_Level_Entity (Ent) and then Scope_Within_Or_Same (Scope (Ent), Subp) + + -- Skip entities defined in inlined subprograms + + and then Chars (Enclosing_Subprogram (Ent)) /= Name_uParent and then -- Constants and variables are interesting diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 9b142c1a0c8..8b0e331e884 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2269,6 +2269,10 @@ package body Inline is -- If the type returned by the function is unconstrained and the call -- can be inlined, special processing is required. + procedure Declare_Postconditions_Result; + -- When generating C code, declare _Result, which may be used in the + -- inlined _Postconditions procedure to verify the return value. + procedure Make_Exit_Label; -- Build declaration for exit label to be used in Return statements, -- sets Exit_Lab (the label node) and Lab_Decl (corresponding implicit @@ -2305,6 +2309,45 @@ package body Inline is function Formal_Is_Used_Once (Formal : Entity_Id) return Boolean; -- Determine whether a formal parameter is used only once in Orig_Bod + ----------------------------------- + -- Declare_Postconditions_Result -- + ----------------------------------- + + procedure Declare_Postconditions_Result is + Enclosing_Subp : constant Entity_Id := Scope (Subp); + + begin + pragma Assert + (Modify_Tree_For_C + and then Is_Subprogram (Enclosing_Subp) + and then Present (Postconditions_Proc (Enclosing_Subp))); + + if Ekind (Enclosing_Subp) = E_Function then + if Nkind (First (Parameter_Associations (N))) + in N_Numeric_Or_String_Literal + then + Append_To (Declarations (Blk), + Make_Object_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Name_uResult), + Constant_Present => True, + Object_Definition => + New_Occurrence_Of (Etype (Enclosing_Subp), Loc), + Expression => + New_Copy_Tree (First (Parameter_Associations (N))))); + else + Append_To (Declarations (Blk), + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Name_uResult), + Subtype_Mark => + New_Occurrence_Of (Etype (Enclosing_Subp), Loc), + Name => + New_Copy_Tree (First (Parameter_Associations (N))))); + end if; + end if; + end Declare_Postconditions_Result; + --------------------- -- Make_Exit_Label -- --------------------- @@ -2834,6 +2877,16 @@ package body Inline is Set_Declarations (Blk, New_List); end if; + -- When generating C code, declare _Result, which may be used to + -- verify the return value. + + if Modify_Tree_For_C + and then Nkind (N) = N_Procedure_Call_Statement + and then Chars (Name (N)) = Name_uPostconditions + then + Declare_Postconditions_Result; + end if; + -- For the unconstrained case, capture the name of the local -- variable that holds the result. This must be the first -- declaration in the block, because its bounds cannot depend diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 30d33d213e2..a0740f0d3e7 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1379,10 +1379,13 @@ package body Sem_Attr is -- Hence, in this context, the spec_id of _postconditions is the -- enclosing scope. - if Generate_C_Code + if Modify_Tree_For_C and then Chars (Spec_Id) = Name_uParent and then Chars (Scope (Spec_Id)) = Name_uPostconditions then + -- This situation occurs only when preanalyzing the inlined body + pragma Assert (not Full_Analysis); + Spec_Id := Scope (Spec_Id); pragma Assert (Is_Inlined (Spec_Id)); end if; @@ -4886,7 +4889,16 @@ package body Sem_Attr is -- the case, then the aspect or pragma is illegal. Return as analysis -- cannot be carried out. - if not Legal then + -- The exception to this rule is when generating C since in this case + -- postconditions are inlined. + + if No (Spec_Id) + and then Modify_Tree_For_C + and then In_Inlined_Body + then + Spec_Id := Entity (P); + + elsif not Legal then return; end if; @@ -5297,7 +5309,16 @@ package body Sem_Attr is -- the case, then the aspect or pragma is illegal. Return as analysis -- cannot be carried out. - if not Legal then + -- The exception to this rule is when generating C since in this case + -- postconditions are inlined. + + if No (Spec_Id) + and then Modify_Tree_For_C + and then In_Inlined_Body + then + Spec_Id := Entity (P); + + elsif not Legal then return; end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 5d5e2dd318f..78c161f0ab0 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -513,7 +513,7 @@ package body Sem_Ch12 is -- If the generic is a local entity and the corresponding body has not -- been seen yet, flag enclosing packages to indicate that it will be -- elaborated after the generic body. Subprograms declared in the same - -- package cannot be inlined by the front-end because front-end inlining + -- package cannot be inlined by the front end because front-end inlining -- requires a strict linear order of elaboration. function Check_Hidden_Primitives (Assoc_List : List_Id) return Elist_Id; @@ -7667,7 +7667,13 @@ package body Sem_Ch12 is -- not carry any semantic information, plus they will be regenerated -- in the instance. - elsif From_Aspect_Specification (N) then + -- However, generating C we need to copy them since postconditions + -- are inlined by the front end, and the front-end inlining machinery + -- relies on this routine to perform inlining. + + elsif From_Aspect_Specification (N) + and then not Modify_Tree_For_C + then New_N := Make_Null_Statement (Sloc (N)); else