[multiple changes]
2016-06-16 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary of Analyze_Declarations, that performs pre-analysis of pre/postconditions on entry declarations before full analysis is performed after entries have been converted into procedures. Done solely to capture semantic errors. * sem_attr.adb (Analyze_Attribute, case 'Result): Add guard to call to Denote_Same_Function. 2016-06-16 Emmanuel Briot <briot@adacore.com> * g-comlin.adb: Fix minor memory leak in GNAT.Command_Line. 2016-06-16 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch7.adb (Find_Last_Init): Remove obsolete code. The logic is now performed by Process_Object_Declaration. (Process_Declarations): Recognize a controlled deferred constant which is in fact initialized by means of a build-in-place function call as needing finalization actions. (Process_Object_Declaration): Insert the counter after the build-in-place initialization call for a controlled object. This was previously done in Find_Last_Init. * exp_util.adb (Requires_Cleanup_Actions): Recognize a controlled deferred constant which is in fact initialized by means of a build-in-place function call as needing finalization actions. 2016-06-16 Justin Squirek <squirek@adacore.com> * exp_aggr.adb (Expand_Array_Aggregate): Minor comment changes and additional style fixes. * exp_ch7.adb: Minor typo fixes and reformatting. From-SVN: r237515
This commit is contained in:
Arnaud Charlet
parent
5ed4ba1574
commit
3386e3ae5d
7 changed files with 163 additions and 81 deletions
|
|
@ -1,3 +1,37 @@
|
|||
2016-06-16 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary
|
||||
of Analyze_Declarations, that performs pre-analysis of
|
||||
pre/postconditions on entry declarations before full analysis
|
||||
is performed after entries have been converted into procedures.
|
||||
Done solely to capture semantic errors.
|
||||
* sem_attr.adb (Analyze_Attribute, case 'Result): Add guard to
|
||||
call to Denote_Same_Function.
|
||||
|
||||
2016-06-16 Emmanuel Briot <briot@adacore.com>
|
||||
|
||||
* g-comlin.adb: Fix minor memory leak in GNAT.Command_Line.
|
||||
|
||||
2016-06-16 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch7.adb (Find_Last_Init): Remove obsolete code. The
|
||||
logic is now performed by Process_Object_Declaration.
|
||||
(Process_Declarations): Recognize a controlled deferred
|
||||
constant which is in fact initialized by means of a
|
||||
build-in-place function call as needing finalization actions.
|
||||
(Process_Object_Declaration): Insert the counter after the
|
||||
build-in-place initialization call for a controlled object. This
|
||||
was previously done in Find_Last_Init.
|
||||
* exp_util.adb (Requires_Cleanup_Actions): Recognize a controlled
|
||||
deferred constant which is in fact initialized by means of a
|
||||
build-in-place function call as needing finalization actions.
|
||||
|
||||
2016-06-16 Justin Squirek <squirek@adacore.com>
|
||||
|
||||
* exp_aggr.adb (Expand_Array_Aggregate): Minor comment changes and
|
||||
additional style fixes.
|
||||
* exp_ch7.adb: Minor typo fixes and reformatting.
|
||||
|
||||
2016-06-16 Justin Squirek <squirek@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Analyze_Object_Declaration): Add a missing check
|
||||
|
|
|
|||
|
|
@ -5517,20 +5517,21 @@ package body Exp_Aggr is
|
|||
-- object. (Note: we don't use a block statement because this would
|
||||
-- cause generated freeze nodes to be elaborated in the wrong scope).
|
||||
|
||||
-- Should document these individual tests ???
|
||||
-- Do not perform in-place expansion for SPARK 05 because aggregates are
|
||||
-- expected to appear in qualified form. In-place expansion eliminates
|
||||
-- the qualification and eventually violates this SPARK 05 restiction.
|
||||
|
||||
-- Should document the rest of the guards ???
|
||||
|
||||
if not Has_Default_Init_Comps (N)
|
||||
and then Comes_From_Source (Parent_Node)
|
||||
and then Parent_Kind = N_Object_Declaration
|
||||
and then not
|
||||
Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ)
|
||||
and then Present (Expression (Parent_Node))
|
||||
and then not Has_Controlled_Component (Typ)
|
||||
and then not Is_Bit_Packed_Array (Typ)
|
||||
|
||||
-- ??? the test for SPARK 05 needs documentation
|
||||
|
||||
and then not Restriction_Check_Required (SPARK_05)
|
||||
and then Comes_From_Source (Parent_Node)
|
||||
and then Parent_Kind = N_Object_Declaration
|
||||
and then Present (Expression (Parent_Node))
|
||||
and then not
|
||||
Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ)
|
||||
and then not Has_Controlled_Component (Typ)
|
||||
and then not Is_Bit_Packed_Array (Typ)
|
||||
and then not Restriction_Check_Required (SPARK_05)
|
||||
then
|
||||
In_Place_Assign_OK_For_Declaration := True;
|
||||
Tmp := Defining_Identifier (Parent_Node);
|
||||
|
|
|
|||
|
|
@ -2100,16 +2100,21 @@ package body Exp_Ch7 is
|
|||
null;
|
||||
|
||||
-- The object is of the form:
|
||||
-- Obj : Typ [:= Expr];
|
||||
-- Obj : [constant] Typ [:= Expr];
|
||||
|
||||
-- Do not process the incomplete view of a deferred constant.
|
||||
-- Do not consider tag-to-class-wide conversions.
|
||||
-- Do not process tag-to-class-wide conversions because they do
|
||||
-- not yield an object. Do not process the incomplete view of a
|
||||
-- deferred constant. Note that an object initialized by means
|
||||
-- of a build-in-place function call may appear as a deferred
|
||||
-- constant after expansion activities. These kinds of objects
|
||||
-- must be finalized.
|
||||
|
||||
elsif not Is_Imported (Obj_Id)
|
||||
and then Needs_Finalization (Obj_Typ)
|
||||
and then not (Ekind (Obj_Id) = E_Constant
|
||||
and then not Has_Completion (Obj_Id))
|
||||
and then not Is_Tag_To_Class_Wide_Conversion (Obj_Id)
|
||||
and then not (Ekind (Obj_Id) = E_Constant
|
||||
and then not Has_Completion (Obj_Id)
|
||||
and then No (BIP_Initialization_Call (Obj_Id)))
|
||||
then
|
||||
Processing_Actions;
|
||||
|
||||
|
|
@ -2757,48 +2762,9 @@ package body Exp_Ch7 is
|
|||
|
||||
Stmt := Next_Suitable_Statement (Decl);
|
||||
|
||||
-- A limited controlled object initialized by a function call uses
|
||||
-- the build-in-place machinery to obtain its value.
|
||||
-- Nothing to do for an object with suppressed initialization
|
||||
|
||||
-- Obj : Lim_Controlled_Type := Func_Call;
|
||||
|
||||
-- is expanded into
|
||||
|
||||
-- Obj : Lim_Controlled_Type;
|
||||
-- type Ptr_Typ is access Lim_Controlled_Type;
|
||||
-- Temp : constant Ptr_Typ :=
|
||||
-- Func_Call
|
||||
-- (BIPalloc => 1,
|
||||
-- BIPaccess => Obj'Unrestricted_Access)'reference;
|
||||
|
||||
-- In this scenario the declaration of the temporary acts as the
|
||||
-- last initialization statement.
|
||||
|
||||
if Is_Limited_Type (Obj_Typ)
|
||||
and then Has_Init_Expression (Decl)
|
||||
and then No (Expression (Decl))
|
||||
then
|
||||
while Present (Stmt) loop
|
||||
if Nkind (Stmt) = N_Object_Declaration
|
||||
and then Present (Expression (Stmt))
|
||||
and then Is_Object_Access_BIP_Func_Call
|
||||
(Expr => Expression (Stmt),
|
||||
Obj_Id => Obj_Id)
|
||||
then
|
||||
Last_Init := Stmt;
|
||||
exit;
|
||||
end if;
|
||||
|
||||
Next (Stmt);
|
||||
end loop;
|
||||
|
||||
-- Nothing to do for an object with supporessed initialization.
|
||||
-- Note that this check is not performed at the beginning of the
|
||||
-- routine because a declaration marked with No_Initialization
|
||||
-- may still be initialized by a build-in-place call (the case
|
||||
-- above).
|
||||
|
||||
elsif No_Initialization (Decl) then
|
||||
if No_Initialization (Decl) then
|
||||
return;
|
||||
|
||||
-- In all other cases the initialization calls follow the related
|
||||
|
|
@ -2937,18 +2903,33 @@ package body Exp_Ch7 is
|
|||
Expression => Make_Integer_Literal (Loc, Counter_Val));
|
||||
|
||||
-- Insert the counter after all initialization has been done. The
|
||||
-- place of insertion depends on the context. If an object is being
|
||||
-- initialized via an aggregate, then the counter must be inserted
|
||||
-- after the last aggregate assignment.
|
||||
-- place of insertion depends on the context.
|
||||
|
||||
if Ekind_In (Obj_Id, E_Constant, E_Variable)
|
||||
and then Present (Last_Aggregate_Assignment (Obj_Id))
|
||||
then
|
||||
Count_Ins := Last_Aggregate_Assignment (Obj_Id);
|
||||
Body_Ins := Empty;
|
||||
if Ekind_In (Obj_Id, E_Constant, E_Variable) then
|
||||
|
||||
-- The object is initialized by a build-in-place function call.
|
||||
-- The counter insertion point is after the function call.
|
||||
|
||||
if Present (BIP_Initialization_Call (Obj_Id)) then
|
||||
Count_Ins := BIP_Initialization_Call (Obj_Id);
|
||||
Body_Ins := Empty;
|
||||
|
||||
-- The object is initialized by an aggregate. Insert the counter
|
||||
-- after the last aggregate assignment.
|
||||
|
||||
elsif Present (Last_Aggregate_Assignment (Obj_Id)) then
|
||||
Count_Ins := Last_Aggregate_Assignment (Obj_Id);
|
||||
Body_Ins := Empty;
|
||||
|
||||
-- In all other cases the counter is inserted after the last call
|
||||
-- to either [Deep_]Initialize or the type-specific init proc.
|
||||
|
||||
else
|
||||
Find_Last_Init (Count_Ins, Body_Ins);
|
||||
end if;
|
||||
|
||||
-- In all other cases the counter is inserted after the last call to
|
||||
-- either [Deep_]Initialize or the type specific init proc.
|
||||
-- either [Deep_]Initialize or the type-specific init proc.
|
||||
|
||||
else
|
||||
Find_Last_Init (Count_Ins, Body_Ins);
|
||||
|
|
|
|||
|
|
@ -2948,10 +2948,9 @@ package body Exp_Util is
|
|||
N_Discriminant_Association,
|
||||
N_Parameter_Association,
|
||||
N_Pragma_Argument_Association)
|
||||
and then not Nkind_In
|
||||
(Parent (Par), N_Function_Call,
|
||||
N_Procedure_Call_Statement,
|
||||
N_Entry_Call_Statement)
|
||||
and then not Nkind_In (Parent (Par), N_Function_Call,
|
||||
N_Procedure_Call_Statement,
|
||||
N_Entry_Call_Statement)
|
||||
|
||||
then
|
||||
return Par;
|
||||
|
|
@ -8279,16 +8278,21 @@ package body Exp_Util is
|
|||
return False;
|
||||
|
||||
-- The object is of the form:
|
||||
-- Obj : Typ [:= Expr];
|
||||
-- Obj : [constant] Typ [:= Expr];
|
||||
--
|
||||
-- Do not process the incomplete view of a deferred constant. Do
|
||||
-- not consider tag-to-class-wide conversions.
|
||||
-- Do not process tag-to-class-wide conversions because they do
|
||||
-- not yield an object. Do not process the incomplete view of a
|
||||
-- deferred constant. Note that an object initialized by means
|
||||
-- of a build-in-place function call may appear as a deferred
|
||||
-- constant after expansion activities. These kinds of objects
|
||||
-- must be finalized.
|
||||
|
||||
elsif not Is_Imported (Obj_Id)
|
||||
and then Needs_Finalization (Obj_Typ)
|
||||
and then not (Ekind (Obj_Id) = E_Constant
|
||||
and then not Has_Completion (Obj_Id))
|
||||
and then not Is_Tag_To_Class_Wide_Conversion (Obj_Id)
|
||||
and then not (Ekind (Obj_Id) = E_Constant
|
||||
and then not Has_Completion (Obj_Id)
|
||||
and then No (BIP_Initialization_Call (Obj_Id)))
|
||||
then
|
||||
return True;
|
||||
|
||||
|
|
|
|||
|
|
@ -3073,6 +3073,7 @@ package body GNAT.Command_Line is
|
|||
Free (Config.Switches (S).Long_Switch);
|
||||
Free (Config.Switches (S).Help);
|
||||
Free (Config.Switches (S).Section);
|
||||
Free (Config.Switches (S).Argument);
|
||||
end loop;
|
||||
|
||||
Unchecked_Free (Config.Switches);
|
||||
|
|
|
|||
|
|
@ -5348,7 +5348,9 @@ package body Sem_Attr is
|
|||
if Is_Entity_Name (P) then
|
||||
Pref_Id := Entity (P);
|
||||
|
||||
if Ekind_In (Pref_Id, E_Function, E_Generic_Function) then
|
||||
if Ekind_In (Pref_Id, E_Function, E_Generic_Function)
|
||||
and then Ekind (Spec_Id) = Ekind (Pref_Id)
|
||||
then
|
||||
if Denote_Same_Function (Pref_Id, Spec_Id) then
|
||||
|
||||
-- Correct the prefix of the attribute when the context
|
||||
|
|
|
|||
|
|
@ -2165,6 +2165,13 @@ package body Sem_Ch3 is
|
|||
-- (They have the sloc of the label as found in the source, and that
|
||||
-- is ahead of the current declarative part).
|
||||
|
||||
procedure Check_Entry_Contracts;
|
||||
-- Perform a pre-analysis of the pre- and postconditions of an entry
|
||||
-- declaration. This must be done before full resolution and creation
|
||||
-- of the parameter block, etc. to catch illegal uses within the
|
||||
-- contract expression. Full analysis of the expression is done when
|
||||
-- the contract is processed.
|
||||
|
||||
procedure Handle_Late_Controlled_Primitive (Body_Decl : Node_Id);
|
||||
-- Determine whether Body_Decl denotes the body of a late controlled
|
||||
-- primitive (either Initialize, Adjust or Finalize). If this is the
|
||||
|
|
@ -2189,6 +2196,56 @@ package body Sem_Ch3 is
|
|||
end loop;
|
||||
end Adjust_Decl;
|
||||
|
||||
---------------------------
|
||||
-- Check_Entry_Contracts --
|
||||
---------------------------
|
||||
|
||||
procedure Check_Entry_Contracts is
|
||||
ASN : Node_Id;
|
||||
Ent : Entity_Id;
|
||||
Exp : Node_Id;
|
||||
|
||||
begin
|
||||
Ent := First_Entity (Current_Scope);
|
||||
while Present (Ent) loop
|
||||
|
||||
-- This only concerns entries with pre/postconditions
|
||||
|
||||
if Ekind (Ent) = E_Entry
|
||||
and then Present (Contract (Ent))
|
||||
and then Present (Pre_Post_Conditions (Contract (Ent)))
|
||||
then
|
||||
ASN := Pre_Post_Conditions (Contract (Ent));
|
||||
Push_Scope (Ent);
|
||||
Install_Formals (Ent);
|
||||
|
||||
-- Pre/postconditions are rewritten as Check pragmas. Analysis
|
||||
-- is performed on a copy of the pragma expression, to prevent
|
||||
-- modifying the original expression.
|
||||
|
||||
while Present (ASN) loop
|
||||
if Nkind (ASN) = N_Pragma then
|
||||
Exp :=
|
||||
New_Copy_Tree
|
||||
(Expression
|
||||
(First (Pragma_Argument_Associations (ASN))));
|
||||
Set_Parent (Exp, ASN);
|
||||
|
||||
-- ??? why not Preanalyze_Assert_Expression
|
||||
|
||||
Preanalyze (Exp);
|
||||
end if;
|
||||
|
||||
ASN := Next_Pragma (ASN);
|
||||
end loop;
|
||||
|
||||
End_Scope;
|
||||
end if;
|
||||
|
||||
Next_Entity (Ent);
|
||||
end loop;
|
||||
end Check_Entry_Contracts;
|
||||
|
||||
--------------------------------------
|
||||
-- Handle_Late_Controlled_Primitive --
|
||||
--------------------------------------
|
||||
|
|
@ -2349,12 +2406,14 @@ package body Sem_Ch3 is
|
|||
-- (This is needed in any case for early instantiations ???).
|
||||
|
||||
if No (Next_Decl) then
|
||||
if Nkind_In (Parent (L), N_Component_List,
|
||||
N_Task_Definition,
|
||||
N_Protected_Definition)
|
||||
then
|
||||
if Nkind (Parent (L)) = N_Component_List then
|
||||
null;
|
||||
|
||||
elsif Nkind_In (Parent (L), N_Protected_Definition,
|
||||
N_Task_Definition)
|
||||
then
|
||||
Check_Entry_Contracts;
|
||||
|
||||
elsif Nkind (Parent (L)) /= N_Package_Specification then
|
||||
if Nkind (Parent (L)) = N_Package_Body then
|
||||
Freeze_From := First_Entity (Current_Scope);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue