2011-12-02 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_dbug.adb: Comment reformatting.
	(Get_External_Name): Use Reset_Buffers to reset the contents of
	Name_Buffer and Homonym_Numbers.
	(Qualify_All_Entity_Names): Reset the contents of Name_Buffer and
	Homonym_Numbers before creating a new qualified name for a particular
	entity.
	(Reset_Buffers): New routine.

2011-12-02  Matthew Heaney  <heaney@adacore.com>

	* a-cbmutr.ads (No_Node): Moved declaration from body to spec
	* a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Iterator): Derives
	from Root_Iterator.
	(Child_Iterator): Derives from Root_Iterator.
	(Finalize): Implemented as an override operation for Root_Iterator.
	(First): Return value depends on Subtree component.
	(Last): Component was renamed from Parent to Subtree.
	(Next): Checks parameter value, and uses simplified loop.
	(Iterate): Forwards to Iterate_Subtree.
	(Iterate_Children): Component was renamed from Parent to Subtree.
	(Iterate_Subtree): Checks parameter value

2011-12-02  Robert Dewar  <dewar@adacore.com>

	* usage.adb: Add lines for -gnatw.n and -gnatw.N
	(atomic sync info msgs).

2011-12-02  Steve Baird  <baird@adacore.com>

	* sem_ch3.adb (Check_Completion): An Ada 2012
	generic formal type doesn't require a completion.

2011-12-02  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_util.adb (Set_Debug_Info_Needed): Also set the flag on the
	packed array type if it is to be set on the array type used to
	represent it.

2011-12-02  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Eliminate confusing use of type name.



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

1 files changed, 76 insertions, 97 deletions

diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb
index b18b15f7534..12d675ad574 100644
--- a/gcc/ada/a-comutr.adb
+++ b/gcc/ada/a-comutr.adb
@@ -34,41 +34,50 @@ with System; use type System.Address;
 
 package body Ada.Containers.Multiway_Trees is
 
-   type Iterator is new Limited_Controlled and
+   --------------------
+   --  Root_Iterator --
+   --------------------
+
+   type Root_Iterator is abstract new Limited_Controlled and
      Tree_Iterator_Interfaces.Forward_Iterator with
    record
       Container : Tree_Access;
-      Position  : Cursor;
-      From_Root : Boolean;
+      Subtree   : Tree_Node_Access;
    end record;
 
-   type Child_Iterator is new Limited_Controlled and
-     Tree_Iterator_Interfaces.Reversible_Iterator with
-   record
-      Container : Tree_Access;
-      Parent    : Tree_Node_Access;
-   end record;
+   overriding procedure Finalize (Object : in out Root_Iterator);
 
-   overriding procedure Finalize (Object : in out Iterator);
+   -----------------------
+   --  Subtree_Iterator --
+   -----------------------
+
+   type Subtree_Iterator is new Root_Iterator with null record;
+
+   overriding function First (Object : Subtree_Iterator) return Cursor;
 
-   overriding function First (Object : Iterator) return Cursor;
    overriding function Next
-     (Object   : Iterator;
+     (Object   : Subtree_Iterator;
       Position : Cursor) return Cursor;
 
-   overriding procedure Finalize (Object : in out Child_Iterator);
+   ---------------------
+   --  Child_Iterator --
+   ---------------------
+
+   type Child_Iterator is new Root_Iterator and
+     Tree_Iterator_Interfaces.Reversible_Iterator with null record;
 
    overriding function First (Object : Child_Iterator) return Cursor;
+
    overriding function Next
      (Object   : Child_Iterator;
       Position : Cursor) return Cursor;
 
+   overriding function Last (Object : Child_Iterator) return Cursor;
+
    overriding function Previous
      (Object   : Child_Iterator;
       Position : Cursor) return Cursor;
 
-   overriding function Last (Object : Child_Iterator) return Cursor;
-
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -909,13 +918,7 @@ package body Ada.Containers.Multiway_Trees is
    -- Finalize --
    --------------
 
-   procedure Finalize (Object : in out Iterator) is
-      B : Natural renames Object.Container.Busy;
-   begin
-      B := B - 1;
-   end Finalize;
-
-   procedure Finalize (Object : in out Child_Iterator) is
+   procedure Finalize (Object : in out Root_Iterator) is
       B : Natural renames Object.Container.Busy;
    begin
       B := B - 1;
@@ -943,14 +946,18 @@ package body Ada.Containers.Multiway_Trees is
    -- First --
    -----------
 
-   function First (Object : Iterator) return Cursor is
+   overriding function First (Object : Subtree_Iterator) return Cursor is
    begin
-      return Object.Position;
+      if Object.Subtree = Root_Node (Object.Container.all) then
+         return First_Child (Root (Object.Container.all));
+      else
+         return Cursor'(Object.Container, Object.Subtree);
+      end if;
    end First;
 
-   function First (Object : Child_Iterator) return Cursor is
+   overriding function First (Object : Child_Iterator) return Cursor is
    begin
-      return First_Child (Cursor'(Object.Container, Object.Parent));
+      return First_Child (Cursor'(Object.Container, Object.Subtree));
    end First;
 
    -----------------
@@ -1376,18 +1383,8 @@ package body Ada.Containers.Multiway_Trees is
    function Iterate (Container : Tree)
      return Tree_Iterator_Interfaces.Forward_Iterator'Class
    is
-      B  : Natural renames Container'Unrestricted_Access.all.Busy;
-      RC : constant Cursor :=
-            (Container'Unrestricted_Access, Root_Node (Container));
-   begin
-      return It : constant Iterator :=
-                    Iterator'(Limited_Controlled with
-                                Container => Container'Unrestricted_Access,
-                                Position  => First_Child (RC),
-                                From_Root => True)
-      do
-         B := B + 1;
-      end return;
+   begin
+      return Iterate_Subtree (Root (Container));
    end Iterate;
 
    ----------------------
@@ -1464,9 +1461,9 @@ package body Ada.Containers.Multiway_Trees is
       end if;
 
       return It : constant Child_Iterator :=
-                    Child_Iterator'(Limited_Controlled with
-                                      Container => C,
-                                      Parent    => Parent.Node)
+                    (Limited_Controlled with
+                       Container => C,
+                       Subtree   => Parent.Node)
       do
          B := B + 1;
       end return;
@@ -1480,16 +1477,25 @@ package body Ada.Containers.Multiway_Trees is
      (Position : Cursor)
       return Tree_Iterator_Interfaces.Forward_Iterator'Class
    is
-      B : Natural renames Position.Container'Unrestricted_Access.all.Busy;
    begin
-      return It : constant Iterator :=
-                    Iterator'(Limited_Controlled with
-                                Container => Position.Container,
-                                Position  => Position,
-                                From_Root => False)
-      do
-         B := B + 1;
-      end return;
+      if Position = No_Element then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      --  Implement Vet for multiway trees???
+      --  pragma Assert (Vet (Position), "bad subtree cursor");
+
+      declare
+         B : Natural renames Position.Container.Busy;
+      begin
+         return It : constant Subtree_Iterator :=
+                       (Limited_Controlled with
+                          Container => Position.Container,
+                          Subtree   => Position.Node)
+         do
+            B := B + 1;
+         end return;
+      end;
    end Iterate_Subtree;
 
    procedure Iterate_Subtree
@@ -1542,7 +1548,7 @@ package body Ada.Containers.Multiway_Trees is
 
    overriding function Last (Object : Child_Iterator) return Cursor is
    begin
-      return Last_Child (Cursor'(Object.Container, Object.Parent));
+      return Last_Child (Cursor'(Object.Container, Object.Subtree));
    end Last;
 
    ----------------
@@ -1612,63 +1618,36 @@ package body Ada.Containers.Multiway_Trees is
    ----------
 
    function Next
-     (Object   : Iterator;
+     (Object   : Subtree_Iterator;
       Position : Cursor) return Cursor
    is
-      T  : Tree renames Position.Container.all;
-      N  : constant Tree_Node_Access := Position.Node;
+      Node : Tree_Node_Access;
 
    begin
-      if Is_Leaf (Position) then
-
-         --  If sibling is present, return it
-
-         if N.Next /= null then
-            return (Object.Container, N.Next);
-
-         --  If this is the last sibling, go to sibling of first ancestor that
-         --  has a sibling, or terminate.
-
-         else
-            declare
-               Par : Tree_Node_Access := N.Parent;
-
-            begin
-               while Par.Next = null loop
-
-                  --  If we are back at the root the iteration is complete
-
-                  if Par = Root_Node (T)  then
-                     return No_Element;
-
-                  --  If this is a subtree iterator and we are back at the
-                  --  starting node, iteration is complete.
+      if Position.Container = null then
+         return No_Element;
+      end if;
 
-                  elsif Par = Object.Position.Node
-                    and then not Object.From_Root
-                  then
-                     return No_Element;
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong tree";
+      end if;
 
-                  else
-                     Par := Par.Parent;
-                  end if;
-               end loop;
+      Node := Position.Node;
 
-               if Par = Object.Position.Node
-                 and then not Object.From_Root
-               then
-                  return No_Element;
-               end if;
+      if Node.Children.First /= null then
+         return Cursor'(Object.Container, Node.Children.First);
+      end if;
 
-               return (Object.Container, Par.Next);
-            end;
+      while Node /= Object.Subtree loop
+         if Node.Next /= null then
+            return Cursor'(Object.Container, Node.Next);
          end if;
 
-      else
-         --  If an internal node, return its first child
+         Node := Node.Parent;
+      end loop;
 
-         return (Object.Container, N.Children.First);
-      end if;
+      return No_Element;
    end Next;
 
    function Next