2013-04-11 Johannes Kanig <kanig@adacore.com>

	* debug.adb: Document usage of -gnatd.Q switch.

2013-04-11  Matthew Heaney  <heaney@adacore.com>

	* a-crbtgk.adb (Ceiling, Find, Floor): Adjust locks
	before element comparisons.
	(Generic_Conditional_Insert, Generic_Conditional_Insert_With_Hint):
	Ditto.
	* a-crbtgo.adb, a-rbtgbo.adb (Generic_Equal): Adjust locks before
	element comparisons.
	* a-rbtgso.adb (Difference, Intersection): Adjust locks
	before element comparisons.
	(Is_Subset, Overlap): Ditto
	(Symmetric_Difference, Union): Ditto
	* a-btgbso.adb (Set_Difference, Set_Intersection): Adjust locks
	before element comparisons.
	(Set_Subset, Set_Overlap): Ditto
	(Set_Symmetric_Difference, Set_Union): Ditto
	* a-coorse.adb, a-ciorse.adb, a-cborse.adb
	(Update_Element_Preserving_Key): Adjust locks before element
	comparisons (Replace_Element): Ditto

2013-04-11  Pascal Obry  <obry@adacore.com>

	* prj-attr.adb, projects.texi, snames.ads-tmpl: Remove Build_Slaves
	attribute.

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Build_Equivalent_Aggregate): Subsidiary of
	Expand_N_Object_Declaration, used to construct an aggregate
	with static components whenever possible, so that objects of a
	discriminated type can be initialized without calling the init.
	proc for the type.

2013-04-11  Vincent Celier  <celier@adacore.com>

	* prj-makr.adb (Process_Directory): On VMS, always delete,
	then recreate the temporary file with Create_Output_Text_File,
	otherwise the output redirection does not work properly.

2013-04-11  Eric Botcazou  <ebotcazou@adacore.com>

	* urealp.ads: Fix minor typo.

2013-04-11  Fabien Chouteau  <chouteau@adacore.com>

	* cio.c (mktemp): Don't use tmpnam function from the
	system on VxWorks in kernel mode.



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

1 files changed, 111 insertions, 17 deletions

diff --git a/gcc/ada/a-coorse.adb b/gcc/ada/a-coorse.adb
index f92760f573d..3f2537367bb 100644
--- a/gcc/ada/a-coorse.adb
+++ b/gcc/ada/a-coorse.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, 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- --
@@ -987,12 +987,15 @@ package body Ada.Containers.Ordered_Sets is
             B : Natural renames Tree.Busy;
             L : Natural renames Tree.Lock;
 
+            Eq : Boolean;
+
          begin
             B := B + 1;
             L := L + 1;
 
             begin
                Process (E);
+               Eq := Equivalent_Keys (K, Key (E));
             exception
                when others =>
                   L := L - 1;
@@ -1003,7 +1006,7 @@ package body Ada.Containers.Ordered_Sets is
             L := L - 1;
             B := B - 1;
 
-            if Equivalent_Keys (K, Key (E)) then
+            if Eq then
                return;
             end if;
          end;
@@ -1716,17 +1719,55 @@ package body Ada.Containers.Ordered_Sets is
          return Node;
       end New_Node;
 
-      Hint      : Node_Access;
-      Result    : Node_Access;
-      Inserted  : Boolean;
+      Hint     : Node_Access;
+      Result   : Node_Access;
+      Inserted : Boolean;
+      Compare  : Boolean;
+
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      B : Natural renames Tree.Busy;
+      L : Natural renames Tree.Lock;
 
-      --  Start of processing for Replace_Element
+   --  Start of processing for Replace_Element
 
    begin
-      if Item < Node.Element or else Node.Element < Item then
-         null;
+      --  Replace_Element assigns value Item to the element designated by Node,
+      --  per certain semantic constraints.
+
+      --  If Item is equivalent to the element, then element is replaced and
+      --  there's nothing else to do. This is the easy case.
+
+      --  If Item is not equivalent, then the node will (possibly) have to move
+      --  to some other place in the tree. This is slighly more complicated,
+      --  because we must ensure that Item is not equivalent to some other
+      --  element in the tree (in which case, the replacement is not allowed).
+
+      --  Determine whether Item is equivalent to element on the specified
+      --  node.
+
+      begin
+         B := B + 1;
+         L := L + 1;
+
+         Compare := (if Item < Node.Element then False
+                     elsif Node.Element < Item then False
+                     else True);
+
+         L := L - 1;
+         B := B - 1;
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
+      if Compare then
+         --  Item is equivalent to the node's element, so we will not have to
+         --  move the node.
 
-      else
          if Tree.Lock > 0 then
             raise Program_Error with
               "attempt to tamper with elements (set is locked)";
@@ -1736,12 +1777,62 @@ package body Ada.Containers.Ordered_Sets is
          return;
       end if;
 
+      --  The replacement Item is not equivalent to the element on the
+      --  specified node, which means that it will need to be re-inserted in a
+      --  different position in the tree. We must now determine whether Item is
+      --  equivalent to some other element in the tree (which would prohibit
+      --  the assignment and hence the move).
+
+      --  Ceiling returns the smallest element equivalent or greater than the
+      --  specified Item; if there is no such element, then it returns null.
+
       Hint := Element_Keys.Ceiling (Tree, Item);
 
-      if Hint = null then
-         null;
+      if Hint /= null then
+         begin
+            B := B + 1;
+            L := L + 1;
+
+            Compare := Item < Hint.Element;
+
+            L := L - 1;
+            B := B - 1;
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         if not Compare then  -- Item >= Hint.Element
+            --  Ceiling returns an element that is equivalent or greater than
+            --  Item. If Item is "not less than" the element, then by
+            --  elimination we know that Item is equivalent to the element.
+
+            --  But this means that it is not possible to assign the value of
+            --  Item to the specified element (on Node), because a different
+            --  element (on Hint) equivalent to Item already exsits. (Were we
+            --  to change Node's element value, we would have to move Node, but
+            --  we would be unable to move the Node, because its new position
+            --  in the tree is already occupied by an equivalent element.)
+
+            raise Program_Error with "attempt to replace existing element";
+         end if;
+
+         --  Item is not equivalent to any other element in the tree, so it is
+         --  safe to assign the value of Item to Node.Element. This means that
+         --  the node will have to move to a different position in the tree
+         --  (because its element will have a different value).
+
+         --  The nearest (greater) neighbor of Item is Hint. This will be the
+         --  insertion position of Node (because its element will have Item as
+         --  its new value).
+
+         --  If Node equals Hint, the relative position of Node does not
+         --  change. This allows us to perform an optimization: we need not
+         --  remove Node from the tree and then reinsert it with its new value,
+         --  because it would only be placed in the exact same position.
 
-      elsif Item < Hint.Element then
          if Hint = Node then
             if Tree.Lock > 0 then
                raise Program_Error with
@@ -1751,15 +1842,18 @@ package body Ada.Containers.Ordered_Sets is
             Node.Element := Item;
             return;
          end if;
-
-      else
-         pragma Assert (not (Hint.Element < Item));
-         raise Program_Error with "attempt to replace existing element";
       end if;
 
+      --  If we get here, it is because Item was greater than all elements in
+      --  the tree (Hint = null), or because Item was less than some element at
+      --  a different place in the tree (Item < Hint.Element). In either case,
+      --  we remove Node from the tree (without actually deallocating it), and
+      --  then insert Item into the tree, onto the same Node (so no new node is
+      --  actually allocated).
+
       Tree_Operations.Delete_Node_Sans_Free (Tree, Node);  -- Checks busy-bit
 
-      Local_Insert_With_Hint
+      Local_Insert_With_Hint  -- use unconditional insert here instead???
         (Tree     => Tree,
          Position => Hint,
          Key      => Item,