Patchwork [Ada] Implement concrete iterators as a type hierarchy for multiway trees

login
register
mail settings
Submitter Arnaud Charlet
Date Dec. 2, 2011, 3 p.m.
Message ID <20111202150054.GA29890@adacore.com>
Download mbox | patch
Permalink /patch/128887/
State New
Headers show

Comments

Arnaud Charlet - Dec. 2, 2011, 3 p.m.
The iterators for the multiway trees are now implemented as a type
hierarchy. Iterating over a tree is the same as iterating over a subtree
starting from the root, and so the tree iterator forwards the request to the
subtree iterator.

Tested on x86_64-pc-linux-gnu, committed on trunk

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

Patch

Index: a-cimutr.adb
===================================================================
--- a-cimutr.adb	(revision 181914)
+++ a-cimutr.adb	(working copy)
@@ -33,41 +33,50 @@ 
 
 package body Ada.Containers.Indefinite_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 --
+   -----------------------
 
-   overriding function First (Object : Iterator) return Cursor;
+   type Subtree_Iterator is new Root_Iterator with null record;
+
+   overriding function First (Object : Subtree_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 --
    -----------------------
@@ -936,18 +945,12 @@ 
    -- Finalize --
    --------------
 
-   procedure Finalize (Object : in out Iterator) is
+   procedure Finalize (Object : in out Root_Iterator) is
       B : Natural renames Object.Container.Busy;
    begin
       B := B - 1;
    end Finalize;
 
-   procedure Finalize (Object : in out Child_Iterator) is
-      B : Natural renames Object.Container.Busy;
-   begin
-      B := B - 1;
-   end Finalize;
-
    ----------
    -- Find --
    ----------
@@ -971,14 +974,18 @@ 
    -- 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;
 
    -----------------
@@ -1348,18 +1355,8 @@ 
    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;
+      return Iterate_Subtree (Root (Container));
    end Iterate;
 
    ----------------------
@@ -1438,7 +1435,7 @@ 
       return It : constant Child_Iterator :=
                     Child_Iterator'(Limited_Controlled with
                                       Container => C,
-                                      Parent    => Parent.Node)
+                                      Subtree   => Parent.Node)
       do
          B := B + 1;
       end return;
@@ -1452,17 +1449,25 @@ 
      (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
@@ -1515,7 +1520,7 @@ 
 
    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;
 
    ----------------
@@ -1585,63 +1590,36 @@ 
    ----------
 
    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 Position.Container = null then
+         return No_Element;
+      end if;
 
-         --  If sibling is present, return it
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong tree";
+      end if;
 
-         if N.Next /= null then
-            return (Object.Container, N.Next);
+      Node := Position.Node;
 
-         --  If this is the last sibling, go to sibling of first ancestor that
-         --  has a sibling, or terminate.
+      if Node.Children.First /= null then
+         return Cursor'(Object.Container, Node.Children.First);
+      end if;
 
-         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.
-
-                  elsif Par = Object.Position.Node
-                    and then not Object.From_Root
-                  then
-                     return No_Element;
-
-                  else
-                     Par := Par.Parent;
-                  end if;
-               end loop;
-
-               if Par = Object.Position.Node
-                 and then not Object.From_Root
-               then
-                  return No_Element;
-               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;
 
-      --  If an internal node, return its first child
+         Node := Node.Parent;
+      end loop;
 
-      else
-         return (Object.Container, N.Children.First);
-      end if;
+      return No_Element;
    end Next;
 
    function Next
Index: a-comutr.adb
===================================================================
--- a-comutr.adb	(revision 181914)
+++ a-comutr.adb	(working copy)
@@ -34,41 +34,50 @@ 
 
 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 --
+   -----------------------
 
-   overriding function First (Object : Iterator) return Cursor;
+   type Subtree_Iterator is new Root_Iterator with null record;
+
+   overriding function First (Object : Subtree_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,18 +918,12 @@ 
    -- Finalize --
    --------------
 
-   procedure Finalize (Object : in out Iterator) is
+   procedure Finalize (Object : in out Root_Iterator) is
       B : Natural renames Object.Container.Busy;
    begin
       B := B - 1;
    end Finalize;
 
-   procedure Finalize (Object : in out Child_Iterator) is
-      B : Natural renames Object.Container.Busy;
-   begin
-      B := B - 1;
-   end Finalize;
-
    ----------
    -- Find --
    ----------
@@ -943,14 +946,18 @@ 
    -- 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 @@ 
    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;
+      return Iterate_Subtree (Root (Container));
    end Iterate;
 
    ----------------------
@@ -1464,9 +1461,9 @@ 
       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 @@ 
      (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 @@ 
 
    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 @@ 
    ----------
 
    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 Position.Container = null then
+         return No_Element;
+      end if;
 
-         --  If sibling is present, return it
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong tree";
+      end if;
 
-         if N.Next /= null then
-            return (Object.Container, N.Next);
+      Node := Position.Node;
 
-         --  If this is the last sibling, go to sibling of first ancestor that
-         --  has a sibling, or terminate.
+      if Node.Children.First /= null then
+         return Cursor'(Object.Container, Node.Children.First);
+      end if;
 
-         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.
-
-                  elsif Par = Object.Position.Node
-                    and then not Object.From_Root
-                  then
-                     return No_Element;
-
-                  else
-                     Par := Par.Parent;
-                  end if;
-               end loop;
-
-               if Par = Object.Position.Node
-                 and then not Object.From_Root
-               then
-                  return No_Element;
-               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
Index: a-cbmutr.adb
===================================================================
--- a-cbmutr.adb	(revision 181914)
+++ a-cbmutr.adb	(working copy)
@@ -33,32 +33,37 @@ 
 
 package body Ada.Containers.Bounded_Multiway_Trees is
 
-   No_Node : constant Count_Type'Base := -1;
+   --------------------
+   --  Root_Iterator --
+   --------------------
 
-   type Iterator is new Limited_Controlled and
+   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   : Count_Type;
    end record;
 
-   overriding procedure Finalize (Object : in out Iterator);
+   overriding procedure Finalize (Object : in out Root_Iterator);
 
-   overriding function First (Object : Iterator) return Cursor;
+   -----------------------
+   --  Subtree_Iterator --
+   -----------------------
 
+   type Subtree_Iterator is new Root_Iterator with null record;
+
+   overriding function First (Object : Subtree_Iterator) return Cursor;
+
    overriding function Next
-     (Object : Iterator;
+     (Object   : Subtree_Iterator;
       Position : Cursor) return Cursor;
 
-   type Child_Iterator is new Limited_Controlled and
-      Tree_Iterator_Interfaces.Reversible_Iterator with
-   record
-      Container : Tree_Access;
-      Parent    : Count_Type;
-   end record;
+   ---------------------
+   --  Child_Iterator --
+   ---------------------
 
-   overriding procedure Finalize (Object : in out 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;
 
@@ -66,12 +71,12 @@ 
      (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 --
    -----------------------
@@ -1242,18 +1247,12 @@ 
    -- Finalize --
    --------------
 
-   procedure Finalize (Object : in out Iterator) is
+   procedure Finalize (Object : in out Root_Iterator) is
       B : Natural renames Object.Container.Busy;
    begin
       B := B - 1;
    end Finalize;
 
-   procedure Finalize (Object : in out Child_Iterator) is
-      B : Natural renames Object.Container.Busy;
-   begin
-      B := B - 1;
-   end Finalize;
-
    ----------
    -- Find --
    ----------
@@ -1278,14 +1277,22 @@ 
       return Cursor'(Container'Unrestricted_Access, Node);
    end Find;
 
-   function First (Object : Iterator) return Cursor is
+   -----------
+   -- First --
+   -----------
+
+   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;
 
    -----------------
@@ -1780,19 +1787,8 @@ 
    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;
+      return Iterate_Subtree (Root (Container));
    end Iterate;
 
    ----------------------
@@ -1879,7 +1875,7 @@ 
       return It : constant Child_Iterator :=
                     Child_Iterator'(Limited_Controlled with
                                       Container => C,
-                                      Parent    => Parent.Node)
+                                      Subtree   => Parent.Node)
       do
          B := B + 1;
       end return;
@@ -1893,17 +1889,25 @@ 
      (Position : Cursor)
       return Tree_Iterator_Interfaces.Forward_Iterator'Class
    is
-      B : Natural renames Position.Container.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
@@ -1962,7 +1966,7 @@ 
 
    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;
 
    ----------------
@@ -2023,67 +2027,43 @@ 
    -- Next --
    ----------
 
-   function Next
-     (Object : Iterator;
+   overriding function Next
+     (Object   : Subtree_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 Position.Container = null then
+         return No_Element;
+      end if;
 
-         --  If sibling is present, return it
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong tree";
+      end if;
 
-         if N.Next /= 0 then
-            return (Object.Container, N.Next);
+      pragma Assert (Object.Container.Count > 0);
+      pragma Assert (Position.Node /= Root_Node (Object.Container.all));
 
-         --  If this is the last sibling, go to sibling of first ancestor that
-         --  has a sibling, or terminate.
+      declare
+         Nodes : Tree_Node_Array renames Object.Container.Nodes;
+         Node  : Count_Type;
+      begin
+         Node := Position.Node;
 
-         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;
+         if Nodes (Node).Children.First > 0 then
+            return Cursor'(Object.Container, Nodes (Node).Children.First);
          end if;
 
-      --  If an internal node, return its first child
+         while Node /= Object.Subtree loop
+            if Nodes (Node).Next > 0 then
+               return Cursor'(Object.Container, Nodes (Node).Next);
+            end if;
 
-      else
-         return (Object.Container, N.Children.First);
-      end if;
+            Node := Nodes (Node).Parent;
+         end loop;
+
+         return No_Element;
+      end;
    end Next;
 
    overriding function Next
@@ -2100,6 +2080,9 @@ 
            "Position cursor of Next designates wrong tree";
       end if;
 
+      pragma Assert (Object.Container.Count > 0);
+      pragma Assert (Position.Node /= Root_Node (Object.Container.all));
+
       return Next_Sibling (Position);
    end Next;
 
Index: a-cbmutr.ads
===================================================================
--- a-cbmutr.ads	(revision 181910)
+++ a-cbmutr.ads	(working copy)
@@ -301,6 +301,8 @@ 
 private
    use Ada.Streams;
 
+   No_Node : constant Count_Type'Base := -1;
+
    type Children_Type is record
       First : Count_Type'Base;
       Last  : Count_Type'Base;
@@ -319,7 +321,7 @@ 
    type Tree (Capacity : Count_Type) is tagged record
       Nodes    : Tree_Node_Array (0 .. Capacity) := (others => <>);
       Elements : Element_Array (1 .. Capacity) := (others => <>);
-      Free     : Count_Type'Base := -1;
+      Free     : Count_Type'Base := No_Node;
       Busy     : Integer := 0;
       Lock     : Integer := 0;
       Count    : Count_Type := 0;
@@ -342,7 +344,7 @@ 
 
    type Cursor is record
       Container : Tree_Access;
-      Node      : Count_Type'Base := -1;
+      Node      : Count_Type'Base := No_Node;
    end record;
 
    procedure  Read