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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@237435 138bc75d-0d04-0410-961f-82ee72b054a4

7 files changed, 146 insertions, 76 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 479c7f04887..cedc29835b8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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,
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index f6d236ffe0a..c85b650d66b 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -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 --
             -----------------------------------------
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index b5074174211..3213b5d56a0 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -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
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index a48cdab695d..36f3ecc1b00 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -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;
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index ff293decd01..5de70d810dc 100644
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -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
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 6237d7b5d0c..020e6d739ce 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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 --
    ------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index d0e3d4ee87f..a1e703fbba9 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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