+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
-- 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.
- 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
+ -- Should document the rest of the guards ???
- and then not Restriction_Check_Required (SPARK_05)
+ if not Has_Default_Init_Comps (N)
+ 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);
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;
Stmt := Next_Suitable_Statement (Decl);
- -- A limited controlled object initialized by a function call uses
- -- the build-in-place machinery to obtain its value.
-
- -- 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).
+ -- Nothing to do for an object with suppressed initialization
- elsif No_Initialization (Decl) then
+ if No_Initialization (Decl) then
return;
-- In all other cases the initialization calls follow the related
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);
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;
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;
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);
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
-- (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
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 --
--------------------------------------
-- (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);
projects / platform / upstream / gcc.git / commitdiff