[multiple changes]

2014-07-16  Vadim Godunko  <godunko@adacore.com>

	* a-coinho-shared.adb (Adjust): Create
	copy of internal shared object and element when source container
	is locked.
	(Copy): Likewise.
	(Query_Element): Likewise.
	(Update_Element): Likewise.
	(Constant_Reference): Likewise. Raise Constraint_Error on attempt
	to get reference for empty holder.
	(Reference): Likewise.

2014-07-16  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb (Find_Hook_Context): New subprogram, extracted
	from Process_Transient_Oject.
	* exp_ch4.ads: Ditto.
	* exp_ch9.adb (Build_Class_Wide_Master): Insert the _master
	declaration as an action on the topmost enclosing expression,
	not on a possibly conditional subexpreession.

From-SVN: r212645

5 files changed, 328 insertions, 223 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0134a76..f2dfb3e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,26 @@
 2014-07-16  Vadim Godunko  <godunko@adacore.com>
 
+	* a-coinho-shared.adb (Adjust): Create
+	copy of internal shared object and element when source container
+	is locked.
+	(Copy): Likewise.
+	(Query_Element): Likewise.
+	(Update_Element): Likewise.
+	(Constant_Reference): Likewise. Raise Constraint_Error on attempt
+	to get reference for empty holder.
+	(Reference): Likewise.
+
+2014-07-16  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch4.adb (Find_Hook_Context): New subprogram, extracted
+	from Process_Transient_Oject.
+	* exp_ch4.ads: Ditto.
+	* exp_ch9.adb (Build_Class_Wide_Master): Insert the _master
+	declaration as an action on the topmost enclosing expression,
+	not on a possibly conditional subexpreession.
+
+2014-07-16  Vadim Godunko  <godunko@adacore.com>
+
 	* a-coinho.adb, a-coinho-shared.adb, a-coinho.ads, a-coinho-shared.ads:
 	Fix parameter mode of Update_Element.
 
diff --git a/gcc/ada/a-coinho-shared.adb b/gcc/ada/a-coinho-shared.adb
index defdf3a..be45c90 100644
--- a/gcc/ada/a-coinho-shared.adb
+++ b/gcc/ada/a-coinho-shared.adb
@@ -57,7 +57,20 @@ package body Ada.Containers.Indefinite_Holders is
    overriding procedure Adjust (Container : in out Holder) is
    begin
       if Container.Reference /= null then
-         Reference (Container.Reference);
+         if Container.Busy = 0 then
+            --  Container is not locked, reuse existing internal shared object.
+
+            Reference (Container.Reference);
+         else
+            --  Otherwise, create copy of both internal shared object and
+            --  element.
+
+            Container.Reference :=
+               new Shared_Holder'
+                 (Counter => <>,
+                  Element =>
+                     new Element_Type'(Container.Reference.Element.all));
+         end if;
       end if;
 
       Container.Busy := 0;
@@ -113,16 +126,34 @@ package body Ada.Containers.Indefinite_Holders is
    ------------------------
 
    function Constant_Reference
-     (Container : aliased Holder) return Constant_Reference_Type
-   is
-      Ref : constant Constant_Reference_Type :=
-              (Element => Container.Reference.Element.all'Access,
-               Control => (Controlled with Container'Unrestricted_Access));
-      B   : Natural renames Ref.Control.Container.Busy;
+     (Container : aliased Holder) return Constant_Reference_Type is
    begin
-      Reference (Ref.Control.Container.Reference);
-      B := B + 1;
-      return Ref;
+      if Container.Reference = null then
+         raise Constraint_Error with "container is empty";
+
+      elsif Container.Busy = 0
+        and then not System.Atomic_Counters.Is_One
+                       (Container.Reference.Counter)
+      then
+         --  Container is not locked and internal shared object is used by
+         --  other container, create copy of both internal shared object and
+         --  element.
+
+         Container'Unrestricted_Access.Reference :=
+            new Shared_Holder'
+              (Counter => <>,
+               Element => new Element_Type'(Container.Reference.Element.all));
+      end if;
+
+      declare
+         Ref : constant Constant_Reference_Type :=
+                 (Element => Container.Reference.Element.all'Access,
+                  Control => (Controlled with Container'Unrestricted_Access));
+      begin
+         Reference (Ref.Control.Container.Reference);
+         Ref.Control.Container.Busy := Ref.Control.Container.Busy + 1;
+         return Ref;
+      end;
    end Constant_Reference;
 
    ----------
@@ -133,10 +164,21 @@ package body Ada.Containers.Indefinite_Holders is
    begin
       if Source.Reference = null then
          return (Controlled with null, 0);
-      else
+      elsif Source.Busy = 0 then
+         --  Container is not locked, reuse internal shared object.
+
          Reference (Source.Reference);
 
          return (Controlled with Source.Reference, 0);
+      else
+         --  Otherwise, create copy of both internal shared object and elemet.
+
+         return
+           (Controlled with
+               new Shared_Holder'
+                 (Counter => <>,
+                  Element => new Element_Type'(Source.Reference.Element.all)),
+               0);
       end if;
    end Copy;
 
@@ -224,6 +266,19 @@ package body Ada.Containers.Indefinite_Holders is
    begin
       if Container.Reference = null then
          raise Constraint_Error with "container is empty";
+
+      elsif Container.Busy = 0
+        and then not System.Atomic_Counters.Is_One
+                       (Container.Reference.Counter)
+      then
+         --  Container is not locked and internal shared object is used by
+         --  other container, create copy of both internal shared object and
+         --  element.
+
+         Container'Unrestricted_Access.Reference :=
+            new Shared_Holder'
+              (Counter => <>,
+               Element => new Element_Type'(Container.Reference.Element.all));
       end if;
 
       B := B + 1;
@@ -284,15 +339,34 @@ package body Ada.Containers.Indefinite_Holders is
    end Reference;
 
    function Reference
-     (Container : aliased in out Holder) return Reference_Type
-   is
-      Ref : constant Reference_Type :=
-              (Element => Container.Reference.Element.all'Access,
-               Control => (Controlled with Container'Unrestricted_Access));
+     (Container : aliased in out Holder) return Reference_Type is
    begin
-      Reference (Ref.Control.Container.Reference);
-      Container.Busy := Container.Busy + 1;
-      return Ref;
+      if Container.Reference = null then
+         raise Constraint_Error with "container is empty";
+
+      elsif Container.Busy = 0
+        and then not System.Atomic_Counters.Is_One
+                       (Container.Reference.Counter)
+      then
+         --  Container is not locked and internal shared object is used by
+         --  other container, create copy of both internal shared object and
+         --  element.
+
+         Container.Reference :=
+            new Shared_Holder'
+              (Counter => <>,
+               Element => new Element_Type'(Container.Reference.Element.all));
+      end if;
+
+      declare
+         Ref : constant Reference_Type :=
+                 (Element => Container.Reference.Element.all'Access,
+                  Control => (Controlled with Container'Unrestricted_Access));
+      begin
+         Reference (Ref.Control.Container.Reference);
+         Ref.Control.Container.Busy := Ref.Control.Container.Busy + 1;
+         return Ref;
+      end;
    end Reference;
 
    ---------------------
@@ -387,6 +461,19 @@ package body Ada.Containers.Indefinite_Holders is
    begin
       if Container.Reference = null then
          raise Constraint_Error with "container is empty";
+
+      elsif Container.Busy = 0
+        and then not System.Atomic_Counters.Is_One
+                       (Container.Reference.Counter)
+      then
+         --  Container is not locked and internal shared object is used by
+         --  other container, create copy of both internal shared object and
+         --  element.
+
+         Container'Unrestricted_Access.Reference :=
+            new Shared_Holder'
+              (Counter => <>,
+               Element => new Element_Type'(Container.Reference.Element.all));
       end if;
 
       B := B + 1;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 5b9eb86..7b97e25 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -11390,6 +11390,145 @@ package body Exp_Ch4 is
       Adjust_Result_Type (N, Typ);
    end Expand_Short_Circuit_Operator;
 
+   -----------------------
+   -- Find_Hook_Context --
+   -----------------------
+
+   function Find_Hook_Context (N : Node_Id) return Node_Id is
+      Par : Node_Id;
+      Top : Node_Id;
+
+      Wrapped_Node : Node_Id;
+      --  Note: if we are in a transient scope, we want to reuse it as
+      --  the context for actions insertion, if possible. But if N is itself
+      --  part of the stored actions for the current transient scope,
+      --  then we need to insert at the appropriate (inner) location in
+      --  the not as an action on Node_To_Be_Wrapped.
+
+      In_Cond_Expr : constant Boolean := Within_Case_Or_If_Expression (N);
+
+   begin
+      --  When the node is inside a case/if expression, the lifetime of any
+      --  temporary controlled object is extended. Find a suitable insertion
+      --  node by locating the topmost case or if expressions.
+
+      if In_Cond_Expr then
+         Par := N;
+         Top := N;
+         while Present (Par) loop
+            if Nkind_In (Original_Node (Par), N_Case_Expression,
+                                              N_If_Expression)
+            then
+               Top := Par;
+
+            --  Prevent the search from going too far
+
+            elsif Is_Body_Or_Package_Declaration (Par) then
+               exit;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         --  The topmost case or if expression is now recovered, but it may
+         --  still not be the correct place to add generated code. Climb to
+         --  find a parent that is part of a declarative or statement list,
+         --  and is not a list of actuals in a call.
+
+         Par := Top;
+         while Present (Par) loop
+            if Is_List_Member (Par)
+              and then not Nkind_In (Par, N_Component_Association,
+                                          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)
+
+            then
+               return Par;
+
+            --  Prevent the search from going too far
+
+            elsif Is_Body_Or_Package_Declaration (Par) then
+               exit;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         return Par;
+
+      else
+         Par := N;
+         while Present (Par) loop
+
+            --  Keep climbing past various operators
+
+            if Nkind (Parent (Par)) in N_Op
+              or else Nkind_In (Parent (Par), N_And_Then, N_Or_Else)
+            then
+               Par := Parent (Par);
+            else
+               exit;
+            end if;
+         end loop;
+
+         Top := Par;
+
+         --  The node may be located in a pragma in which case return the
+         --  pragma itself:
+
+         --    pragma Precondition (... and then Ctrl_Func_Call ...);
+
+         --  Similar case occurs when the node is related to an object
+         --  declaration or assignment:
+
+         --    Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
+
+         --  Another case to consider is when the node is part of a return
+         --  statement:
+
+         --    return ... and then Ctrl_Func_Call ...;
+
+         --  Another case is when the node acts as a formal in a procedure
+         --  call statement:
+
+         --    Proc (... and then Ctrl_Func_Call ...);
+
+         if Scope_Is_Transient then
+            Wrapped_Node := Node_To_Be_Wrapped;
+         else
+            Wrapped_Node := Empty;
+         end if;
+
+         while Present (Par) loop
+            if Par = Wrapped_Node
+              or else Nkind_In (Par, N_Assignment_Statement,
+                                     N_Object_Declaration,
+                                     N_Pragma,
+                                     N_Procedure_Call_Statement,
+                                     N_Simple_Return_Statement)
+            then
+               return Par;
+
+            --  Prevent the search from going too far
+
+            elsif Is_Body_Or_Package_Declaration (Par) then
+               exit;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         --  Return the topmost short circuit operator
+
+         return Top;
+      end if;
+   end Find_Hook_Context;
+
    -------------------------------------
    -- Fixup_Universal_Fixed_Operation --
    -------------------------------------
@@ -12548,8 +12687,19 @@ package body Exp_Ch4 is
      (Decl     : Node_Id;
       Rel_Node : Node_Id)
    is
-      Hook_Context         : Node_Id;
-      --  Node on which to insert the hook pointer (as an action)
+      Loc       : constant Source_Ptr := Sloc (Decl);
+      Obj_Id    : constant Entity_Id  := Defining_Identifier (Decl);
+      Obj_Typ   : constant Node_Id    := Etype (Obj_Id);
+      Desig_Typ : Entity_Id;
+      Expr      : Node_Id;
+      Fin_Stmts : List_Id;
+      Ptr_Id    : Entity_Id;
+      Temp_Id   : Entity_Id;
+      Temp_Ins  : Node_Id;
+
+      Hook_Context         : constant Node_Id := Find_Hook_Context (Rel_Node);
+      --  Node on which to insert the hook pointer (as an action): the
+      --  innermost enclosing non-transient scope.
 
       Finalization_Context : Node_Id;
       --  Node after which to insert finalization actions
@@ -12558,215 +12708,55 @@ package body Exp_Ch4 is
       --  If False, call to finalizer includes a test of whether the
       --  hook pointer is null.
 
-      procedure Find_Enclosing_Contexts (N : Node_Id);
-      --  Find the logical context where N appears, and initialize
-      --  Hook_Context and Finalization_Context accordingly. Also
-      --  sets Finalize_Always.
-
-      -----------------------------
-      -- Find_Enclosing_Contexts --
-      -----------------------------
-
-      procedure Find_Enclosing_Contexts (N : Node_Id) is
-         Par : Node_Id;
-         Top : Node_Id;
-
-         Wrapped_Node : Node_Id;
-         --  Note: if we are in a transient scope, we want to reuse it as
-         --  the context for actions insertion, if possible. But if N is itself
-         --  part of the stored actions for the current transient scope,
-         --  then we need to insert at the appropriate (inner) location in
-         --  the not as an action on Node_To_Be_Wrapped.
-
-         In_Cond_Expr : constant Boolean := Within_Case_Or_If_Expression (N);
-
-      begin
-         --  When the node is inside a case/if expression, the lifetime of any
-         --  temporary controlled object is extended. Find a suitable insertion
-         --  node by locating the topmost case or if expressions.
-
-         if In_Cond_Expr then
-            Par := N;
-            Top := N;
-            while Present (Par) loop
-               if Nkind_In (Original_Node (Par), N_Case_Expression,
-                                                 N_If_Expression)
-               then
-                  Top := Par;
-
-               --  Prevent the search from going too far
-
-               elsif Is_Body_Or_Package_Declaration (Par) then
-                  exit;
-               end if;
-
-               Par := Parent (Par);
-            end loop;
-
-            --  The topmost case or if expression is now recovered, but it may
-            --  still not be the correct place to add generated code. Climb to
-            --  find a parent that is part of a declarative or statement list,
-            --  and is not a list of actuals in a call.
-
-            Par := Top;
-            while Present (Par) loop
-               if Is_List_Member (Par)
-                 and then not Nkind_In (Par, N_Component_Association,
-                                             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)
-
-               then
-                  Hook_Context := Par;
-                  goto Hook_Context_Found;
-
-               --  Prevent the search from going too far
-
-               elsif Is_Body_Or_Package_Declaration (Par) then
-                  exit;
-               end if;
-
-               Par := Parent (Par);
-            end loop;
-
-            Hook_Context := Par;
-            goto Hook_Context_Found;
-
-         else
-            Par := N;
-            while Present (Par) loop
-
-               --  Keep climbing past various operators
-
-               if Nkind (Parent (Par)) in N_Op
-                 or else Nkind_In (Parent (Par), N_And_Then, N_Or_Else)
-               then
-                  Par := Parent (Par);
-               else
-                  exit;
-               end if;
-            end loop;
-
-            Top := Par;
-
-            --  The node may be located in a pragma in which case return the
-            --  pragma itself:
-
-            --    pragma Precondition (... and then Ctrl_Func_Call ...);
-
-            --  Similar case occurs when the node is related to an object
-            --  declaration or assignment:
-
-            --    Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
-
-            --  Another case to consider is when the node is part of a return
-            --  statement:
-
-            --    return ... and then Ctrl_Func_Call ...;
-
-            --  Another case is when the node acts as a formal in a procedure
-            --  call statement:
-
-            --    Proc (... and then Ctrl_Func_Call ...);
-
-            if Scope_Is_Transient then
-               Wrapped_Node := Node_To_Be_Wrapped;
-            else
-               Wrapped_Node := Empty;
-            end if;
-
-            while Present (Par) loop
-               if Par = Wrapped_Node
-                 or else Nkind_In (Par, N_Assignment_Statement,
-                                        N_Object_Declaration,
-                                        N_Pragma,
-                                        N_Procedure_Call_Statement,
-                                        N_Simple_Return_Statement)
-               then
-                  Hook_Context := Par;
-                  goto Hook_Context_Found;
-
-               --  Prevent the search from going too far
-
-               elsif Is_Body_Or_Package_Declaration (Par) then
-                  exit;
-               end if;
-
-               Par := Parent (Par);
-            end loop;
-
-            --  Return the topmost short circuit operator
-
-            Hook_Context := Top;
-         end if;
-
-      <<Hook_Context_Found>>
-
-         --  Special case for Boolean EWAs: capture expression in a temporary,
-         --  whose declaration will serve as the context around which to insert
-         --  finalization code. The finalization thus remains local to the
-         --  specific condition being evaluated.
+      In_Cond_Expr : constant Boolean :=
+                       Within_Case_Or_If_Expression (Rel_Node);
 
-         if Is_Boolean_Type (Etype (N)) then
-
-            --  In this case, the finalization context is chosen so that
-            --  we know at finalization point that the hook pointer is
-            --  never null, so no need for a test, we can call the finalizer
-            --  unconditionally, except in the case where the object is
-            --  created in a specific branch of a conditional expression.
+   begin
+      --  Step 0: determine where to attach finalization actions in the tree
 
-            Finalize_Always :=
-               not (In_Cond_Expr
-                     or else
-                       Nkind_In (Original_Node (N), N_Case_Expression,
-                                                    N_If_Expression));
+      --  Special case for Boolean EWAs: capture expression in a temporary,
+      --  whose declaration will serve as the context around which to insert
+      --  finalization code. The finalization thus remains local to the
+      --  specific condition being evaluated.
 
-            declare
-               Loc  : constant Source_Ptr := Sloc (N);
-               Temp : constant Entity_Id := Make_Temporary (Loc, 'E', N);
-
-            begin
-               Append_To (Actions (N),
-                 Make_Object_Declaration (Loc,
-                   Defining_Identifier => Temp,
-                   Constant_Present    => True,
-                   Object_Definition   =>
-                     New_Occurrence_Of (Etype (N), Loc),
-                   Expression          => Expression (N)));
-               Finalization_Context := Last (Actions (N));
+      if Is_Boolean_Type (Etype (Rel_Node)) then
 
-               Analyze (Last (Actions (N)));
+         --  In this case, the finalization context is chosen so that
+         --  we know at finalization point that the hook pointer is
+         --  never null, so no need for a test, we can call the finalizer
+         --  unconditionally, except in the case where the object is
+         --  created in a specific branch of a conditional expression.
 
-               Set_Expression (N, New_Occurrence_Of (Temp, Loc));
-               Analyze (Expression (N));
-            end;
+         Finalize_Always :=
+            not (In_Cond_Expr
+                  or else
+                    Nkind_In (Original_Node (Rel_Node), N_Case_Expression,
+                                                        N_If_Expression));
 
-         else
-            Finalize_Always := False;
-            Finalization_Context := Hook_Context;
-         end if;
-      end Find_Enclosing_Contexts;
+         declare
+            Loc  : constant Source_Ptr := Sloc (Rel_Node);
+            Temp : constant Entity_Id := Make_Temporary (Loc, 'E', Rel_Node);
 
-      --  Local variables
+         begin
+            Append_To (Actions (Rel_Node),
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Temp,
+                Constant_Present    => True,
+                Object_Definition   =>
+                  New_Occurrence_Of (Etype (Rel_Node), Loc),
+                Expression          => Expression (Rel_Node)));
+            Finalization_Context := Last (Actions (Rel_Node));
 
-      Loc       : constant Source_Ptr := Sloc (Decl);
-      Obj_Id    : constant Entity_Id  := Defining_Identifier (Decl);
-      Obj_Typ   : constant Node_Id    := Etype (Obj_Id);
-      Desig_Typ : Entity_Id;
-      Expr      : Node_Id;
-      Fin_Stmts : List_Id;
-      Ptr_Id    : Entity_Id;
-      Temp_Id   : Entity_Id;
-      Temp_Ins  : Node_Id;
+            Analyze (Last (Actions (Rel_Node)));
 
-   --  Start of processing for Process_Transient_Object
+            Set_Expression (Rel_Node, New_Occurrence_Of (Temp, Loc));
+            Analyze (Expression (Rel_Node));
+         end;
 
-   begin
-      Find_Enclosing_Contexts (Rel_Node);
+      else
+         Finalize_Always := False;
+         Finalization_Context := Hook_Context;
+      end if;
 
       --  Step 1: Create the access type which provides a reference to the
       --  transient controlled object.
diff --git a/gcc/ada/exp_ch4.ads b/gcc/ada/exp_ch4.ads
index 676aeb2..c7686f7 100644
--- a/gcc/ada/exp_ch4.ads
+++ b/gcc/ada/exp_ch4.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -103,4 +103,11 @@ package Exp_Ch4 is
    --  have special circuitry in Expand_N_Type_Conversion to promote both of
    --  the operands to type Integer.
 
+   function Find_Hook_Context (N : Node_Id) return Node_Id;
+   --  Determine a suitable node on which to attach actions related to N
+   --  that need to be elaborated unconditionally (i.e. in general the topmost
+   --  expression of which N is a subexpression, which may or may not be
+   --  evaluated, for example if N is the right operand of a short circuit
+   --  operator).
+
 end Exp_Ch4;
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index e1a4d0f..c8f2943 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -29,6 +29,7 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Ch3;  use Exp_Ch3;
+with Exp_Ch4;  use Exp_Ch4;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch11; use Exp_Ch11;
 with Exp_Dbug; use Exp_Dbug;
@@ -1151,7 +1152,6 @@ package body Exp_Ch9 is
       then
          declare
             Master_Decl : Node_Id;
-
          begin
             Set_Has_Master_Entity (Master_Scope);
 
@@ -1169,7 +1169,7 @@ package body Exp_Ch9 is
                   Make_Explicit_Dereference (Loc,
                     New_Occurrence_Of (RTE (RE_Current_Master), Loc)));
 
-            Insert_Action (Related_Node, Master_Decl);
+            Insert_Action (Find_Hook_Context (Related_Node), Master_Decl);
             Analyze (Master_Decl);
 
             --  Mark the containing scope as a task master. Masters associated