+2016-06-14 Ed Schonberg <schonberg@adacore.com>
+
+ * contracts.adb (Has_Null_Body): Move to sem_util, for general
+ availability.
+ * sem_util.ads, sem_util.adb (Has_Null_Body): Predicate to
+ determine when an internal procedure created for some assertion
+ checking (e.g. type invariant) is a null procedure. Used to
+ eliminate redundant calls to such procedures when they apply to
+ components of composite types.
+ * exp_ch3.adb (Build_Component_Invariant_Call): Do not add call
+ if invariant procedure has a null body.
+
+2016-06-14 Thomas Quinot <quinot@adacore.com>
+
+ * g-socket.ads (Check_Selector): Clarify effect on IN OUT socket
+ set parameters.
+
+2016-06-14 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch4.adb (Process_Action): Pass the action
+ list to Process_Transient_Object.
+ (Process_If_Case_Statements): Pass the action list to
+ Process_Transient_Object.
+ (Process_Transient_Object): Add new parameter Stmts and update the
+ comment on usage. When the context is a Boolean evaluation, insert
+ any finalization calls after the last statement of the construct.
+
2016-06-14 Tristan Gingold <gingold@adacore.com>
* einfo.adb, einfo.ads (Has_Timing_Event,
-------------------------
function Invariant_Checks_OK (Typ : Entity_Id) return Boolean is
- function Has_Null_Body (Proc_Id : Entity_Id) return Boolean;
- -- Determine whether the body of procedure Proc_Id contains a sole
- -- null statement, possibly followed by an optional return.
-
function Has_Public_Visibility_Of_Subprogram return Boolean;
-- Determine whether type Typ has public visibility of subprogram
-- Subp_Id.
- -------------------
- -- Has_Null_Body --
- -------------------
-
- function Has_Null_Body (Proc_Id : Entity_Id) return Boolean is
- Body_Id : Entity_Id;
- Decl : Node_Id;
- Spec : Node_Id;
- Stmt1 : Node_Id;
- Stmt2 : Node_Id;
-
- begin
- Spec := Parent (Proc_Id);
- Decl := Parent (Spec);
-
- -- Retrieve the entity of the invariant procedure body
-
- if Nkind (Spec) = N_Procedure_Specification
- and then Nkind (Decl) = N_Subprogram_Declaration
- then
- Body_Id := Corresponding_Body (Decl);
-
- -- The body acts as a spec
-
- else
- Body_Id := Proc_Id;
- end if;
-
- -- The body will be generated later
-
- if No (Body_Id) then
- return False;
- end if;
-
- Spec := Parent (Body_Id);
- Decl := Parent (Spec);
-
- pragma Assert
- (Nkind (Spec) = N_Procedure_Specification
- and then Nkind (Decl) = N_Subprogram_Body);
-
- Stmt1 := First (Statements (Handled_Statement_Sequence (Decl)));
-
- -- Look for a null statement followed by an optional return
- -- statement.
-
- if Nkind (Stmt1) = N_Null_Statement then
- Stmt2 := Next (Stmt1);
-
- if Present (Stmt2) then
- return Nkind (Stmt2) = N_Simple_Return_Statement;
- else
- return True;
- end if;
- end if;
-
- return False;
- end Has_Null_Body;
-
-----------------------------------------
-- Has_Public_Visibility_Of_Subprogram --
-----------------------------------------
Sel_Comp : Node_Id;
Typ : Entity_Id;
Call : Node_Id;
+ Proc : Entity_Id;
begin
- Invariant_Found := True;
Typ := Etype (Comp);
Sel_Comp :=
-- The aspect is type-specific, so retrieve it from the base type
+ Proc := Invariant_Procedure (Base_Type (Typ));
+
+ if Has_Null_Body (Proc) then
+ return Make_Null_Statement (Loc);
+ end if;
+
+ Invariant_Found := True;
Call :=
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (Invariant_Procedure (Base_Type (Typ)), Loc),
+ Name => New_Occurrence_Of (Proc, Loc),
Parameter_Associations => New_List (Sel_Comp));
if Is_Access_Type (Etype (Comp)) then
-- generates code to clean them up when the context of the expression is
-- evaluated or elaborated.
- procedure Process_Transient_Object (Decl : Node_Id; N : Node_Id);
+ procedure Process_Transient_Object
+ (Decl : Node_Id;
+ N : Node_Id;
+ Stmts : List_Id);
-- Subsidiary routine to the expansion of expression_with_actions, if and
-- case expressions. Generate all necessary code to finalize a transient
-- controlled object when the enclosing context is elaborated or evaluated.
-- Decl denotes the declaration of the transient controlled object which is
-- usually the result of a controlled function call. N denotes the related
- -- expression_with_actions, if expression, or case expression.
+ -- expression_with_actions, if expression, or case expression node. Stmts
+ -- denotes the statement list which contains Decl, either at the top level
+ -- or within a nested construct.
procedure Rewrite_Comparison (N : Node_Id);
-- If N is the node for a comparison whose outcome can be determined at
if Nkind (Act) = N_Object_Declaration
and then Is_Finalizable_Transient (Act, N)
then
- Process_Transient_Object (Act, N);
+ Process_Transient_Object (Act, N, Acts);
return Abandon;
-- Avoid processing temporary function results multiple times when
-- do not leak to the expression of the expression_with_actions node:
-- do
- -- Trans_Id : Ctrl_Typ : ...;
+ -- Trans_Id : Ctrl_Typ := ...;
-- Alias : ... := Trans_Id;
-- in ... Alias ... end;
-- reference to the Alias within the actions list:
-- do
- -- Trans_Id : Ctrl_Typ : ...;
+ -- Trans_Id : Ctrl_Typ := ...;
-- Alias : ... := Trans_Id;
-- Val : constant Boolean := ... Alias ...;
-- <finalize Trans_Id>
if Nkind (Decl) = N_Object_Declaration
and then Is_Finalizable_Transient (Decl, N)
then
- Process_Transient_Object (Decl, N);
+ Process_Transient_Object (Decl, N, Stmts);
end if;
Next (Decl);
-- Process_Transient_Object --
------------------------------
- procedure Process_Transient_Object (Decl : Node_Id; N : Node_Id) is
+ procedure Process_Transient_Object
+ (Decl : Node_Id;
+ N : Node_Id;
+ Stmts : List_Id)
+ is
Loc : constant Source_Ptr := Sloc (Decl);
Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Node_Id := Etype (Obj_Id);
-- transient controlled object.
begin
+ pragma Assert (Nkind_In (N, N_Case_Expression,
+ N_Expression_With_Actions,
+ N_If_Expression));
+
+ -- When the context is a Boolean evaluation, all three nodes capture the
+ -- result of their computation in a local temporary:
+
+ -- do
+ -- Trans_Id : Ctrl_Typ := ...;
+ -- Result : constant Boolean := ... Trans_Id ...;
+ -- <finalize Trans_Id>
+ -- in Result end;
+
+ -- As a result, the finalization of any transient controlled objects can
+ -- safely take place after the result capture.
+
+ -- ??? could this be extended to elementary types?
+
if Is_Boolean_Type (Etype (N)) then
- Fin_Context := Last (List_Containing (Decl));
+ Fin_Context := Last (Stmts);
+
+ -- Otherwise the immediate context may not be safe enough to carry out
+ -- transient controlled object finalization due to aliasing and nesting
+ -- of constructs. Insert calls to [Deep_]Finalize after the innermost
+ -- enclosing non-transient construct.
+
else
Fin_Context := Hook_Context;
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2014, AdaCore --
+-- Copyright (C) 2001-2016, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--
-- Note that two different Socket_Set_Type objects must be passed as
-- R_Socket_Set and W_Socket_Set (even if they denote the same set of
- -- Sockets), or some event may be lost.
+ -- Sockets), or some event may be lost. Also keep in mind that this
+ -- procedure modifies the passed socket sets to indicate which sockets
+ -- actually had events upon return. The socket set therefore has to
+ -- be reset by the caller for further calls.
--
-- Socket_Error is raised when the select(2) system call returns an error
-- condition, or when a read error occurs on the signalling socket used for
and then Nkind (Node (First_Elmt (Constits))) /= N_Null;
end Has_Non_Null_Refinement;
+ -------------------
+ -- Has_Null_Body --
+ -------------------
+
+ function Has_Null_Body (Proc_Id : Entity_Id) return Boolean is
+ Body_Id : Entity_Id;
+ Decl : Node_Id;
+ Spec : Node_Id;
+ Stmt1 : Node_Id;
+ Stmt2 : Node_Id;
+
+ begin
+ Spec := Parent (Proc_Id);
+ Decl := Parent (Spec);
+
+ -- Retrieve the entity of the procedure body (e.g. invariant proc).
+
+ if Nkind (Spec) = N_Procedure_Specification
+ and then Nkind (Decl) = N_Subprogram_Declaration
+ then
+ Body_Id := Corresponding_Body (Decl);
+
+ -- The body acts as a spec
+
+ else
+ Body_Id := Proc_Id;
+ end if;
+
+ -- The body will be generated later
+
+ if No (Body_Id) then
+ return False;
+ end if;
+
+ Spec := Parent (Body_Id);
+ Decl := Parent (Spec);
+
+ pragma Assert
+ (Nkind (Spec) = N_Procedure_Specification
+ and then Nkind (Decl) = N_Subprogram_Body);
+
+ Stmt1 := First (Statements (Handled_Statement_Sequence (Decl)));
+
+ -- Look for a null statement followed by an optional return
+ -- statement.
+
+ if Nkind (Stmt1) = N_Null_Statement then
+ Stmt2 := Next (Stmt1);
+
+ if Present (Stmt2) then
+ return Nkind (Stmt2) = N_Simple_Return_Statement;
+ else
+ return True;
+ end if;
+ end if;
+
+ return False;
+ end Has_Null_Body;
+
------------------------
-- Has_Null_Exclusion --
------------------------
-- as expressed in pragma Refined_State. This function does not take into
-- account the visible refinement region of abstract state Id.
+ function Has_Null_Body (Proc_Id : Entity_Id) return Boolean;
+ -- Determine whether the body of procedure Proc_Id contains a sole
+ -- null statement, possibly followed by an optional return. Used to
+ -- optimize useless calls to assertion checks.
+
function Has_Null_Exclusion (N : Node_Id) return Boolean;
-- Determine whether node N has a null exclusion
projects / gcc.git / commitdiff