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:
parent
5a52795215
commit
64f5d139b9
@ -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:
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user