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 <hea...@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.
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;