[multiple changes]
2014-07-29 Robert Dewar <dewar@adacore.com> * sem_util.adb, sem_util.ads, sem_res.adb, exp_ch6.adb: Invert predicate No_Predicate_Test_On_Arguments, new name is Predicate_Tests_On_Arguments (with the opposite sense). 2014-07-29 Hristian Kirtchev <kirtchev@adacore.com> * sem_attr.adb (Resolve_Attribute): Clean up the code for attribute 'Access. Do not generate an elaboration flag for a stand alone expression function. The expression of an expression function is now frozen when the expression function appears as the prefix of attribute 'Access. * sem_ch6.adb (Analyze_Expression_Function): Remove local variable New_Decl and update all references to it after the rewriting has taken place. Establish the linkages between the generated spec and body. From-SVN: r213212
This commit is contained in:
Arnaud Charlet
parent
094cf3330c
commit
b8e6830b34
7 changed files with 141 additions and 82 deletions
|
|
@ -1,3 +1,21 @@
|
|||
2014-07-29 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_util.adb, sem_util.ads, sem_res.adb, exp_ch6.adb: Invert
|
||||
predicate No_Predicate_Test_On_Arguments, new name is
|
||||
Predicate_Tests_On_Arguments (with the opposite sense).
|
||||
|
||||
2014-07-29 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_attr.adb (Resolve_Attribute): Clean up the code for
|
||||
attribute 'Access. Do not generate an elaboration flag for a
|
||||
stand alone expression function. The expression of an expression
|
||||
function is now frozen when the expression function appears as
|
||||
the prefix of attribute 'Access.
|
||||
* sem_ch6.adb (Analyze_Expression_Function): Remove local
|
||||
variable New_Decl and update all references to it after the
|
||||
rewriting has taken place. Establish the linkages between the
|
||||
generated spec and body.
|
||||
|
||||
2014-07-29 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_prag.adb (ip, rv): Prevent from being optimized away.
|
||||
|
|
|
|||
|
|
@ -1754,7 +1754,7 @@ package body Exp_Ch6 is
|
|||
|
||||
-- Skip predicate checks for special cases
|
||||
|
||||
and then not No_Predicate_Test_On_Arguments (Subp)
|
||||
and then Predicate_Tests_On_Arguments (Subp)
|
||||
then
|
||||
Append_To (Post_Call,
|
||||
Make_Predicate_Check (Atyp, Actual));
|
||||
|
|
|
|||
|
|
@ -86,7 +86,9 @@ package body Sem_Attr is
|
|||
-- used so that we can abandon the processing so we don't run into
|
||||
-- trouble with cascaded errors.
|
||||
|
||||
-- The following array is the list of attributes defined in the Ada 83 RM:
|
||||
-- The following array is the list of attributes defined in the Ada 83 RM.
|
||||
-- In Ada 83 mode, these are the only recognized attributes. In other Ada
|
||||
-- modes all these attributes are recognized, even if removed in Ada 95.
|
||||
|
||||
Attribute_83 : constant Attribute_Class_Array := Attribute_Class_Array'(
|
||||
Attribute_Address |
|
||||
|
|
@ -10565,11 +10567,18 @@ package body Sem_Attr is
|
|||
Set_Address_Taken (Entity (P));
|
||||
end if;
|
||||
|
||||
if Is_Entity_Name (P) then
|
||||
-- Deal with possible elaboration check
|
||||
|
||||
if Is_Entity_Name (P) and then Is_Subprogram (Entity (P)) then
|
||||
declare
|
||||
E : constant Entity_Id := Entity (P);
|
||||
Decl : Node_Id;
|
||||
Flag : Entity_Id;
|
||||
Subp_Id : constant Entity_Id := Entity (P);
|
||||
Scop : constant Entity_Id := Scope (Subp_Id);
|
||||
Subp_Decl : constant Node_Id :=
|
||||
Unit_Declaration_Node (Subp_Id);
|
||||
|
||||
Flag_Id : Entity_Id;
|
||||
HSS : Node_Id;
|
||||
Stmt : Node_Id;
|
||||
|
||||
-- If the access has been taken and the body of the subprogram
|
||||
-- has not been see yet, indirect calls must be protected with
|
||||
|
|
@ -10578,40 +10587,67 @@ package body Sem_Attr is
|
|||
-- a subprogram the body will appear in the same declarative
|
||||
-- part, and we must insert a check in the eventual body itself
|
||||
-- using the elaboration flag that we generate now. The check
|
||||
-- is then inserted when the body is expanded.
|
||||
-- is then inserted when the body is expanded. This processing
|
||||
-- is not needed for a stand alone expression function because
|
||||
-- the internally generated spec and body are always inserted
|
||||
-- as a pair in the same declarative list.
|
||||
|
||||
begin
|
||||
if Is_Subprogram (E)
|
||||
and then Expander_Active
|
||||
and then Comes_From_Source (E)
|
||||
if Expander_Active
|
||||
and then Comes_From_Source (Subp_Id)
|
||||
and then Comes_From_Source (N)
|
||||
and then In_Open_Scopes (Scope (E))
|
||||
and then
|
||||
Ekind_In (Scope (E), E_Block, E_Procedure, E_Function)
|
||||
and then not Has_Completion (E)
|
||||
and then No (Elaboration_Entity (E))
|
||||
and then Nkind (Unit_Declaration_Node (E)) =
|
||||
N_Subprogram_Declaration
|
||||
and then In_Open_Scopes (Scop)
|
||||
and then Ekind_In (Scop, E_Block, E_Procedure, E_Function)
|
||||
and then not Has_Completion (Subp_Id)
|
||||
and then No (Elaboration_Entity (Subp_Id))
|
||||
and then Nkind (Subp_Decl) = N_Subprogram_Declaration
|
||||
and then Nkind (Original_Node (Subp_Decl)) /=
|
||||
N_Expression_Function
|
||||
then
|
||||
-- Create elaboration variable for it
|
||||
|
||||
Flag := Make_Temporary (Loc, 'E');
|
||||
Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Flag,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Standard_Short_Integer, Loc),
|
||||
Expression =>
|
||||
Make_Integer_Literal (Loc, Uint_0));
|
||||
Set_Elaboration_Entity (E, Flag);
|
||||
Set_Is_Frozen (Flag);
|
||||
Flag_Id := Make_Temporary (Loc, 'E');
|
||||
Set_Elaboration_Entity (Subp_Id, Flag_Id);
|
||||
Set_Is_Frozen (Flag_Id);
|
||||
|
||||
-- Insert declaration for flag after subprogram
|
||||
-- declaration. Note that attribute reference may
|
||||
-- appear within a nested scope.
|
||||
|
||||
Insert_After (Unit_Declaration_Node (E), Decl);
|
||||
Analyze (Decl);
|
||||
Insert_After_And_Analyze (Subp_Decl,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Flag_Id,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Standard_Short_Integer, Loc),
|
||||
Expression =>
|
||||
Make_Integer_Literal (Loc, Uint_0)));
|
||||
end if;
|
||||
|
||||
-- Taking the 'Access of an expression function freezes its
|
||||
-- expression (RM 13.14 10.3/3). This does not apply to an
|
||||
-- expression function that acts as a completion because the
|
||||
-- generated body is immediately analyzed and the expression
|
||||
-- is automatically frozen.
|
||||
|
||||
if Ekind (Subp_Id) = E_Function
|
||||
and then Nkind (Subp_Decl) = N_Subprogram_Declaration
|
||||
and then Nkind (Original_Node (Subp_Decl)) =
|
||||
N_Expression_Function
|
||||
and then Present (Corresponding_Body (Subp_Decl))
|
||||
and then not Analyzed (Corresponding_Body (Subp_Decl))
|
||||
then
|
||||
HSS :=
|
||||
Handled_Statement_Sequence
|
||||
(Unit_Declaration_Node
|
||||
(Corresponding_Body (Subp_Decl)));
|
||||
|
||||
if Present (HSS) then
|
||||
Stmt := First (Statements (HSS));
|
||||
|
||||
if Nkind (Stmt) = N_Simple_Return_Statement then
|
||||
Freeze_Expression (Expression (Stmt));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -266,7 +266,6 @@ package body Sem_Ch6 is
|
|||
-- declaration is completed. Def_Id is needed to analyze the spec.
|
||||
|
||||
New_Body : Node_Id;
|
||||
New_Decl : Node_Id;
|
||||
New_Spec : Node_Id;
|
||||
Ret : Node_Id;
|
||||
|
||||
|
|
@ -434,10 +433,7 @@ package body Sem_Ch6 is
|
|||
("an expression function is not a legal protected operation", N);
|
||||
end if;
|
||||
|
||||
New_Decl :=
|
||||
Make_Subprogram_Declaration (Loc, Specification => Spec);
|
||||
|
||||
Rewrite (N, New_Decl);
|
||||
Rewrite (N, Make_Subprogram_Declaration (Loc, Specification => Spec));
|
||||
|
||||
-- Correct the parent pointer of the aspect specification list to
|
||||
-- reference the rewritten node.
|
||||
|
|
@ -447,7 +443,15 @@ package body Sem_Ch6 is
|
|||
end if;
|
||||
|
||||
Analyze (N);
|
||||
Set_Is_Inlined (Defining_Entity (New_Decl));
|
||||
Set_Is_Inlined (Defining_Entity (N));
|
||||
|
||||
-- Establish the linkages between the spec and the body. These are
|
||||
-- used when the expression function acts as the prefix of attribute
|
||||
-- 'Access in order to freeze the original expression which has been
|
||||
-- moved to the generated body.
|
||||
|
||||
Set_Corresponding_Body (N, Defining_Entity (New_Body));
|
||||
Set_Corresponding_Spec (New_Body, Defining_Entity (N));
|
||||
|
||||
-- To prevent premature freeze action, insert the new body at the end
|
||||
-- of the current declarations, or at the end of the package spec.
|
||||
|
|
@ -461,7 +465,7 @@ package body Sem_Ch6 is
|
|||
declare
|
||||
Decls : List_Id := List_Containing (N);
|
||||
Par : constant Node_Id := Parent (Decls);
|
||||
Id : constant Entity_Id := Defining_Entity (New_Decl);
|
||||
Id : constant Entity_Id := Defining_Entity (N);
|
||||
|
||||
begin
|
||||
if Nkind (Par) = N_Package_Specification
|
||||
|
|
|
|||
|
|
@ -1974,7 +1974,7 @@ package body Sem_Res is
|
|||
if Nkind (Decl) = N_Subprogram_Body then
|
||||
Spec := Corresponding_Spec (Decl);
|
||||
|
||||
if not No (Spec) then
|
||||
if Present (Spec) then
|
||||
Decl := Unit_Declaration_Node (Spec);
|
||||
end if;
|
||||
end if;
|
||||
|
|
@ -4051,9 +4051,9 @@ package body Sem_Res is
|
|||
-- Apply predicate tests except in certain special cases. Note
|
||||
-- that it might be more consistent to apply these only when
|
||||
-- expansion is active (in Exp_Ch6.Expand_Actuals), as we do
|
||||
-- for the outbound predicate tests.
|
||||
-- for the outbound predicate tests ???
|
||||
|
||||
if not No_Predicate_Test_On_Arguments (Nam) then
|
||||
if Predicate_Tests_On_Arguments (Nam) then
|
||||
Apply_Predicate_Check (A, F_Typ);
|
||||
end if;
|
||||
|
||||
|
|
|
|||
|
|
@ -13785,44 +13785,6 @@ package body Sem_Util is
|
|||
Actual_Id := Next_Actual (Actual_Id);
|
||||
end Next_Actual;
|
||||
|
||||
------------------------------------
|
||||
-- No_Predicate_Test_On_Arguments --
|
||||
------------------------------------
|
||||
|
||||
function No_Predicate_Test_On_Arguments (Subp : Entity_Id) return Boolean is
|
||||
begin
|
||||
-- Do not test predicates on call to generated default Finalize, since
|
||||
-- we are not interested in whether something we are finalizing (and
|
||||
-- typically destroying) satisfies its predicates.
|
||||
|
||||
if Chars (Subp) = Name_Finalize
|
||||
and then not Comes_From_Source (Subp)
|
||||
then
|
||||
return True;
|
||||
|
||||
-- Do not test predicates on call to Init_Proc, since if needed the
|
||||
-- predicate test will occur at some other point.
|
||||
|
||||
elsif Is_Init_Proc (Subp) then
|
||||
return True;
|
||||
|
||||
-- Do not test predicates on call to predicate function, since this
|
||||
-- would cause infinite recursion.
|
||||
|
||||
elsif Ekind (Subp) = E_Function
|
||||
and then (Is_Predicate_Function (Subp)
|
||||
or else
|
||||
Is_Predicate_Function_M (Subp))
|
||||
then
|
||||
return True;
|
||||
|
||||
-- For now, no other cases
|
||||
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
end No_Predicate_Test_On_Arguments;
|
||||
|
||||
---------------------
|
||||
-- No_Scalar_Parts --
|
||||
---------------------
|
||||
|
|
@ -14755,6 +14717,44 @@ package body Sem_Util is
|
|||
end if;
|
||||
end Original_Corresponding_Operation;
|
||||
|
||||
----------------------------------
|
||||
-- Predicate_Tests_On_Arguments --
|
||||
----------------------------------
|
||||
|
||||
function Predicate_Tests_On_Arguments (Subp : Entity_Id) return Boolean is
|
||||
begin
|
||||
-- Do not test predicates on call to generated default Finalize, since
|
||||
-- we are not interested in whether something we are finalizing (and
|
||||
-- typically destroying) satisfies its predicates.
|
||||
|
||||
if Chars (Subp) = Name_Finalize
|
||||
and then not Comes_From_Source (Subp)
|
||||
then
|
||||
return False;
|
||||
|
||||
-- Do not test predicates on call to Init_Proc, since if needed the
|
||||
-- predicate test will occur at some other point.
|
||||
|
||||
elsif Is_Init_Proc (Subp) then
|
||||
return False;
|
||||
|
||||
-- Do not test predicates on call to predicate function, since this
|
||||
-- would cause infinite recursion.
|
||||
|
||||
elsif Ekind (Subp) = E_Function
|
||||
and then (Is_Predicate_Function (Subp)
|
||||
or else
|
||||
Is_Predicate_Function_M (Subp))
|
||||
then
|
||||
return False;
|
||||
|
||||
-- For now, no other exceptions
|
||||
|
||||
else
|
||||
return True;
|
||||
end if;
|
||||
end Predicate_Tests_On_Arguments;
|
||||
|
||||
-----------------------
|
||||
-- Private_Component --
|
||||
-----------------------
|
||||
|
|
|
|||
|
|
@ -1582,11 +1582,6 @@ package Sem_Util is
|
|||
-- Note that the result produced is always an expression, not a parameter
|
||||
-- association node, even if named notation was used.
|
||||
|
||||
function No_Predicate_Test_On_Arguments (Subp : Entity_Id) return Boolean;
|
||||
-- Subp is the entity for a subprogram call. This function returns True to
|
||||
-- eliminate predicate tests on the input or output arguments in a call to
|
||||
-- this subprogram. See body for exact cases currently covered.
|
||||
|
||||
function No_Scalar_Parts (T : Entity_Id) return Boolean;
|
||||
-- Tests if type T can be determined at compile time to have no scalar
|
||||
-- parts in the sense of the Valid_Scalars attribute. Returns True if
|
||||
|
|
@ -1634,6 +1629,12 @@ package Sem_Util is
|
|||
-- Name_uPre, Name_uPost, Name_uInvariant, or Name_uType_Invariant being
|
||||
-- returned to represent the corresponding aspects with x'Class names.
|
||||
|
||||
function Predicate_Tests_On_Arguments (Subp : Entity_Id) return Boolean;
|
||||
-- Subp is the entity for a subprogram call. This function returns True if
|
||||
-- predicate tests are required for the arguments in this call (this is the
|
||||
-- normal case). It returns False for special cases where these predicate
|
||||
-- tests should be skipped (see body for details).
|
||||
|
||||
function Primitive_Names_Match (E1, E2 : Entity_Id) return Boolean;
|
||||
-- Returns True if the names of both entities correspond with matching
|
||||
-- primitives. This routine includes support for the case in which one
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue