2011-09-24 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 179138 using svnmerge.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@179139 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 166 insertions, 3 deletions

diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb
index e206e98e38f..32ab0828942 100644
--- a/gcc/ada/a-cbmutr.adb
+++ b/gcc/ada/a-cbmutr.adb
@@ -28,9 +28,22 @@
 ------------------------------------------------------------------------------
 
 with System;  use type System.Address;
-
 package body Ada.Containers.Bounded_Multiway_Trees is
 
+   No_Node : constant Count_Type'Base := -1;
+
+   type Iterator is new Tree_Iterator_Interfaces.Forward_Iterator with
+   record
+      Container : Tree_Access;
+      Position  : Cursor;
+      From_Root : Boolean;
+   end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Next
+     (Object : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -381,7 +394,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
          First     => First,
          Last      => Last,
          Parent    => Parent.Node,
-         Before    => -1);  -- means "insert at end of list"
+         Before    => No_Node);  -- means "insert at end of list"
 
       Container.Count := Container.Count + Count;
    end Append_Child;
@@ -1223,6 +1236,11 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       return Cursor'(Container'Unrestricted_Access, Node);
    end Find;
 
+   function First (Object : Iterator) return Cursor is
+   begin
+      return Object.Position;
+   end First;
+
    -----------------
    -- First_Child --
    -----------------
@@ -1367,7 +1385,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
    is
    begin
       Container.Nodes (Index) :=
-        (Parent   => -1,
+        (Parent   => No_Node,
          Prev     => 0,
          Next     => 0,
          Children => (others => 0));
@@ -1715,6 +1733,23 @@ package body Ada.Containers.Bounded_Multiway_Trees is
          raise;
    end Iterate;
 
+   function Iterate (Container : Tree)
+     return Tree_Iterator_Interfaces.Forward_Iterator'Class
+   is
+      Root_Cursor : constant Cursor :=
+        (Container'Unrestricted_Access, Root_Node (Container));
+   begin
+      return
+        Iterator'(Container'Unrestricted_Access,
+                     First_Child (Root_Cursor), From_Root => True);
+   end Iterate;
+
+   function Iterate_Subtree (Position : Cursor)
+     return Tree_Iterator_Interfaces.Forward_Iterator'Class is
+   begin
+      return Iterator'(Position.Container, Position, From_Root => False);
+   end Iterate_Subtree;
+
    ----------------------
    -- Iterate_Children --
    ----------------------
@@ -1888,6 +1923,74 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       Source.Clear;
    end Move;
 
+   ----------
+   -- Next --
+   ----------
+
+   function Next
+     (Object : Iterator;
+      Position : Cursor) return Cursor
+   is
+      T  : Tree renames Position.Container.all;
+      NN : Tree_Node_Array renames T.Nodes;
+      N  : Tree_Node_Type renames NN (Position.Node);
+
+   begin
+      if Is_Leaf (Position) then
+
+         --  If sibling is present, return it.
+
+         if N.Next /= 0 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
+               Pos : Count_Type := N.Parent;
+               Par : Tree_Node_Type := NN (Pos);
+
+            begin
+               while Par.Next = 0 loop
+                  Pos := Par.Parent;
+
+                  --  If we are back at the root the iteration is complete.
+
+                  if Pos = No_Node then
+                     return No_Element;
+
+                  --  If this is a subtree iterator and we are back at the
+                  --  starting node, iteration is complete.
+
+                  elsif Pos = Object.Position.Node
+                    and then not Object.From_Root
+                  then
+                     return No_Element;
+
+                  else
+                     Par := NN (Pos);
+                  end if;
+               end loop;
+
+               if Pos = Object.Position.Node
+                 and then not Object.From_Root
+               then
+                  return No_Element;
+               end if;
+
+               return (Object.Container, Par.Next);
+            end;
+         end if;
+
+      else
+
+         --  If an internal node, return its first child.
+
+         return (Object.Container, N.Children.First);
+      end if;
+   end Next;
+
    ------------------
    -- Next_Sibling --
    ------------------
@@ -2224,6 +2327,50 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       raise Program_Error with "attempt to read tree cursor from stream";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference
+     (Container : aliased Tree;
+      Position  : Cursor) return Constant_Reference_Type
+   is
+   begin
+      pragma Unreferenced (Container);
+
+      return
+        (Element =>
+            Position.Container.Elements (Position.Node)'Unchecked_Access);
+   end Constant_Reference;
+
+   function Reference
+     (Container : aliased Tree;
+      Position  : Cursor) return Reference_Type
+   is
+   begin
+      pragma Unreferenced (Container);
+
+      return
+        (Element =>
+            Position.Container.Elements (Position.Node)'Unchecked_Access);
+   end Reference;
+
    --------------------
    -- Remove_Subtree --
    --------------------
@@ -3073,4 +3220,20 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       raise Program_Error with "attempt to write tree cursor to stream";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Bounded_Multiway_Trees;