+2016-06-14 Javier Miranda <miranda@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
* sem_ch7.adb, sem_ch12.adb, freeze.adb, lib-xref.ads, exp_ch3.adb:
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;
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);
-- 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.
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,
-- 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),
-- 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,
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
-- 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
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
-- 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
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 --
---------------------
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
-- 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;
-- 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;
-- 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;
-- 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;
-- 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
projects / gcc.git / commitdiff