OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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.

From-SVN: r237435
This commit is contained in:
Arnaud Charlet 2016-06-14 14:33:56 +02:00
parent 4969efdf7d
commit 7782ff6771
7 changed files with 146 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/ada/ChangeLog
View File

@ -1,3 +1,30 @@
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,

63
gcc/ada/contracts.adb
View File

@ -1452,73 +1452,10 @@ package body Contracts is
-------------------------
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 --
-----------------------------------------

12
gcc/ada/exp_ch3.adb
View File

@ -3714,9 +3714,9 @@ package body Exp_Ch3 is
Sel_Comp : Node_Id;
Typ : Entity_Id;
Call : Node_Id;
Proc : Entity_Id;
begin
Invariant_Found := True;
Typ := Etype (Comp);
Sel_Comp :=
@ -3744,10 +3744,16 @@ package body Exp_Ch3 is
-- 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

49
gcc/ada/exp_ch4.adb
View File

@ -230,13 +230,18 @@ package body Exp_Ch4 is
-- 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
@ -4992,7 +4997,7 @@ package body Exp_Ch4 is
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
@ -5037,7 +5042,7 @@ package body Exp_Ch4 is
-- 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;
@ -5047,7 +5052,7 @@ package body Exp_Ch4 is
-- 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>
@ -12909,7 +12914,7 @@ package body Exp_Ch4 is
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);
@ -12920,7 +12925,11 @@ package body Exp_Ch4 is
-- 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);
@ -12940,8 +12949,32 @@ package body Exp_Ch4 is
-- 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;

7
gcc/ada/g-socket.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1107,7 +1107,10 @@ package GNAT.Sockets is
--
-- 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

59
gcc/ada/sem_util.adb
View File

@ -9581,6 +9581,65 @@ package body Sem_Util is
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 --
------------------------

5
gcc/ada/sem_util.ads
View File

@ -1103,6 +1103,11 @@ package Sem_Util is
-- 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