[Ada] Check preconditions for child iterator of multiway tree container
Arnaud Charlet
charlet@adacore.com
Fri Dec 2 14:46:00 GMT 2011
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.
-------------- next part --------------
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;
More information about the Gcc-patches
mailing list