sem_attr.adb (Analyze_Attribute_Old_Result): Adding assertion.

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.

From-SVN: r237437
This commit is contained in:
Javier Miranda 2016-06-14 12:37:54 +00:00 committed by Arnaud Charlet
parent 5a52795215
commit 64f5d139b9
7 changed files with 162 additions and 13 deletions

View File

@ -1,3 +1,22 @@
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:

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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;

View File

@ -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