Patchwork [Ada] Check preconditions for child iterator of multiway tree container

login
register
mail settings
Submitter Arnaud Charlet
Date Dec. 2, 2011, 2:46 p.m.
Message ID <20111202144625.GA23381@adacore.com>
Download mbox | patch
Permalink /patch/128879/
State New
Headers show

Comments

Arnaud Charlet - Dec. 2, 2011, 2:46 p.m.
The iterator for visiting children of a node in a multiway tree must check the
value of the Parent parameter to ensure that it is non-null, and that it
actually designates a node in the tree.

There were also several instances where cursor values returned by iterator
operations were not well-formed. That has been corrected by forwarding the
iterator operation to the corresponding cursor-based operation.

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

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

	* a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Iterator): Rename
	Position component.
	(Finalize): Remove unnecessary access check.
	(First): Forward to First_Child.
	(Last): Forward to Last_Child.
	(Iterate): Check preconditions for parent node parameter.
	(Next): Forward to Next_Sibling.
	(Previous): Forward to Previous_Sibling.

Patch

Index: a-cimutr.adb
===================================================================
--- a-cimutr.adb	(revision 181912)
+++ a-cimutr.adb	(working copy)
@@ -45,7 +45,7 @@ 
      Tree_Iterator_Interfaces.Reversible_Iterator with
    record
       Container : Tree_Access;
-      Position  : Cursor;
+      Parent    : Tree_Node_Access;
    end record;
 
    overriding procedure Finalize (Object : in out Iterator);
@@ -937,25 +937,15 @@ 
    --------------
 
    procedure Finalize (Object : in out Iterator) is
+      B : Natural renames Object.Container.Busy;
    begin
-      if Object.Container /= null then
-         declare
-            B : Natural renames Object.Container.all.Busy;
-         begin
-            B := B - 1;
-         end;
-      end if;
+      B := B - 1;
    end Finalize;
 
    procedure Finalize (Object : in out Child_Iterator) is
+      B : Natural renames Object.Container.Busy;
    begin
-      if Object.Container /= null then
-         declare
-            B : Natural renames Object.Container.all.Busy;
-         begin
-            B := B - 1;
-         end;
-      end if;
+      B := B - 1;
    end Finalize;
 
    ----------
@@ -988,7 +978,7 @@ 
 
    function First (Object : Child_Iterator) return Cursor is
    begin
-      return (Object.Container, Object.Position.Node.Children.First);
+      return First_Child (Cursor'(Object.Container, Object.Parent));
    end First;
 
    -----------------
@@ -1433,13 +1423,22 @@ 
       Parent    : Cursor)
      return Tree_Iterator_Interfaces.Reversible_Iterator'Class
    is
-      B : Natural renames Container'Unrestricted_Access.all.Busy;
+      C : constant Tree_Access := Container'Unrestricted_Access;
+      B : Natural renames C.Busy;
 
    begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= C then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
       return It : constant Child_Iterator :=
                     Child_Iterator'(Limited_Controlled with
-                                      Container => Parent.Container,
-                                      Position  => Parent)
+                                      Container => C,
+                                      Parent    => Parent.Node)
       do
          B := B + 1;
       end return;
@@ -1516,7 +1515,7 @@ 
 
    overriding function Last (Object : Child_Iterator) return Cursor is
    begin
-      return (Object.Container, Object.Position.Node.Children.Last);
+      return Last_Child (Cursor'(Object.Container, Object.Parent));
    end Last;
 
    ----------------
@@ -1646,18 +1645,20 @@ 
    end Next;
 
    function Next
-     (Object : Child_Iterator;
+     (Object   : Child_Iterator;
       Position : Cursor) return Cursor
    is
-      C : constant Tree_Node_Access := Position.Node.Next;
-
    begin
-      if C = null then
+      if Position.Container = null then
          return No_Element;
+      end if;
 
-      else
-         return (Object.Container, C);
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong tree";
       end if;
+
+      return Next_Sibling (Position);
    end Next;
 
    ------------------
@@ -1787,18 +1788,20 @@ 
    --------------
 
    overriding function Previous
-     (Object : Child_Iterator;
+     (Object   : Child_Iterator;
       Position : Cursor) return Cursor
    is
-      C : constant Tree_Node_Access := Position.Node.Prev;
-
    begin
-      if C = null then
+      if Position.Container = null then
          return No_Element;
+      end if;
 
-      else
-         return (Object.Container, C);
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Previous designates wrong tree";
       end if;
+
+      return Previous_Sibling (Position);
    end Previous;
 
    ----------------------
Index: a-comutr.adb
===================================================================
--- a-comutr.adb	(revision 181913)
+++ a-comutr.adb	(working copy)
@@ -46,7 +46,7 @@ 
      Tree_Iterator_Interfaces.Reversible_Iterator with
    record
       Container : Tree_Access;
-      Position  : Cursor;
+      Parent    : Tree_Node_Access;
    end record;
 
    overriding procedure Finalize (Object : in out Iterator);
@@ -910,25 +910,15 @@ 
    --------------
 
    procedure Finalize (Object : in out Iterator) is
+      B : Natural renames Object.Container.Busy;
    begin
-      if Object.Container /= null then
-         declare
-            B : Natural renames Object.Container.all.Busy;
-         begin
-            B := B - 1;
-         end;
-      end if;
+      B := B - 1;
    end Finalize;
 
    procedure Finalize (Object : in out Child_Iterator) is
+      B : Natural renames Object.Container.Busy;
    begin
-      if Object.Container /= null then
-         declare
-            B : Natural renames Object.Container.all.Busy;
-         begin
-            B := B - 1;
-         end;
-      end if;
+      B := B - 1;
    end Finalize;
 
    ----------
@@ -960,7 +950,7 @@ 
 
    function First (Object : Child_Iterator) return Cursor is
    begin
-      return (Object.Container, Object.Position.Node.Children.First);
+      return First_Child (Cursor'(Object.Container, Object.Parent));
    end First;
 
    -----------------
@@ -1461,12 +1451,22 @@ 
       Parent    : Cursor)
       return Tree_Iterator_Interfaces.Reversible_Iterator'Class
    is
-      B : Natural renames Container'Unrestricted_Access.all.Busy;
+      C : constant Tree_Access := Container'Unrestricted_Access;
+      B : Natural renames C.Busy;
+
    begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= C then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
       return It : constant Child_Iterator :=
                     Child_Iterator'(Limited_Controlled with
-                                      Container => Parent.Container,
-                                      Position  => Parent)
+                                      Container => C,
+                                      Parent    => Parent.Node)
       do
          B := B + 1;
       end return;
@@ -1542,7 +1542,7 @@ 
 
    overriding function Last (Object : Child_Iterator) return Cursor is
    begin
-      return (Object.Container, Object.Position.Node.Children.Last);
+      return Last_Child (Cursor'(Object.Container, Object.Parent));
    end Last;
 
    ----------------
@@ -1675,9 +1675,17 @@ 
      (Object   : Child_Iterator;
       Position : Cursor) return Cursor
    is
-      C : constant Tree_Node_Access := Position.Node.Next;
    begin
-      return (if C = null then No_Element else (Object.Container, C));
+      if Position.Container = null then
+         return No_Element;
+      end if;
+
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong tree";
+      end if;
+
+      return Next_Sibling (Position);
    end Next;
 
    ------------------
@@ -1807,9 +1815,17 @@ 
      (Object   : Child_Iterator;
       Position : Cursor) return Cursor
    is
-      C : constant Tree_Node_Access := Position.Node.Prev;
    begin
-      return (if C = null then No_Element else (Object.Container, C));
+      if Position.Container = null then
+         return No_Element;
+      end if;
+
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Previous designates wrong tree";
+      end if;
+
+      return Previous_Sibling (Position);
    end Previous;
 
    ----------------------
Index: a-cbmutr.adb
===================================================================
--- a-cbmutr.adb	(revision 181912)
+++ a-cbmutr.adb	(working copy)
@@ -55,7 +55,7 @@ 
       Tree_Iterator_Interfaces.Reversible_Iterator with
    record
       Container : Tree_Access;
-      Position  : Cursor;
+      Parent    : Count_Type;
    end record;
 
    overriding procedure Finalize (Object : in out Child_Iterator);
@@ -1243,25 +1243,15 @@ 
    --------------
 
    procedure Finalize (Object : in out Iterator) is
+      B : Natural renames Object.Container.Busy;
    begin
-      if Object.Container /= null then
-         declare
-            B : Natural renames Object.Container.all.Busy;
-         begin
-            B := B - 1;
-         end;
-      end if;
+      B := B - 1;
    end Finalize;
 
    procedure Finalize (Object : in out Child_Iterator) is
+      B : Natural renames Object.Container.Busy;
    begin
-      if Object.Container /= null then
-         declare
-            B : Natural renames Object.Container.all.Busy;
-         begin
-            B := B - 1;
-         end;
-      end if;
+      B := B - 1;
    end Finalize;
 
    ----------
@@ -1294,10 +1284,8 @@ 
    end First;
 
    function First (Object : Child_Iterator) return Cursor is
-      Node : Count_Type'Base;
    begin
-      Node := Object.Container.Nodes (Object.Position.Node).Children.First;
-      return (Object.Container, Node);
+      return First_Child (Cursor'(Object.Container, Object.Parent));
    end First;
 
    -----------------
@@ -1876,13 +1864,22 @@ 
       Parent    : Cursor)
       return Tree_Iterator_Interfaces.Reversible_Iterator'Class
    is
-      B : Natural renames Container'Unrestricted_Access.all.Busy;
+      C : constant Tree_Access := Container'Unrestricted_Access;
+      B : Natural renames C.Busy;
 
    begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= C then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
       return It : constant Child_Iterator :=
                     Child_Iterator'(Limited_Controlled with
-                                      Container => Parent.Container,
-                                      Position  => Parent)
+                                      Container => C,
+                                      Parent    => Parent.Node)
       do
          B := B + 1;
       end return;
@@ -1965,7 +1962,7 @@ 
 
    overriding function Last (Object : Child_Iterator) return Cursor is
    begin
-      return Last_Child (Object.Position);
+      return Last_Child (Cursor'(Object.Container, Object.Parent));
    end Last;
 
    ----------------
@@ -2089,15 +2086,20 @@ 
       end if;
    end Next;
 
-   function Next
+   overriding function Next
      (Object   : Child_Iterator;
       Position : Cursor) return Cursor
    is
    begin
-      if Object.Container /= Position.Container then
-         raise Program_Error;
+      if Position.Container = null then
+         return No_Element;
       end if;
 
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong tree";
+      end if;
+
       return Next_Sibling (Position);
    end Next;
 
@@ -2255,10 +2257,15 @@ 
       Position : Cursor) return Cursor
    is
    begin
-      if Object.Container /= Position.Container then
-         raise Program_Error;
+      if Position.Container = null then
+         return No_Element;
       end if;
 
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Previous designates wrong tree";
+      end if;
+
       return Previous_Sibling (Position);
    end Previous;