From 0add5a9536ca3595ad7c6d7999fba0ccf5dc9740 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 2 Dec 2011 16:00:35 +0100 Subject: [multiple changes] 2011-12-02 Hristian Kirtchev * exp_dbug.adb: Comment reformatting. (Get_External_Name): Use Reset_Buffers to reset the contents of Name_Buffer and Homonym_Numbers. (Qualify_All_Entity_Names): Reset the contents of Name_Buffer and Homonym_Numbers before creating a new qualified name for a particular entity. (Reset_Buffers): New routine. 2011-12-02 Matthew Heaney * 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 2011-12-02 Robert Dewar * usage.adb: Add lines for -gnatw.n and -gnatw.N (atomic sync info msgs). 2011-12-02 Steve Baird * sem_ch3.adb (Check_Completion): An Ada 2012 generic formal type doesn't require a completion. 2011-12-02 Eric Botcazou * sem_util.adb (Set_Debug_Info_Needed): Also set the flag on the packed array type if it is to be set on the array type used to represent it. 2011-12-02 Robert Dewar * gnat_rm.texi: Eliminate confusing use of type name. From-SVN: r181919 --- gcc/ada/a-comutr.adb | 173 ++++++++++++++++++++++----------------------------- 1 file changed, 76 insertions(+), 97 deletions(-) (limited to 'gcc/ada/a-comutr.adb') diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb index b18b15f..12d675a 100644 --- a/gcc/ada/a-comutr.adb +++ b/gcc/ada/a-comutr.adb @@ -34,41 +34,50 @@ with System; use type System.Address; 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 -- + ----------------------- + + type Subtree_Iterator is new Root_Iterator with null record; + + overriding function First (Object : Subtree_Iterator) return Cursor; - overriding function First (Object : 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,13 +918,7 @@ package body Ada.Containers.Multiway_Trees is -- Finalize -- -------------- - procedure Finalize (Object : in out Iterator) is - B : Natural renames Object.Container.Busy; - begin - B := B - 1; - end Finalize; - - procedure Finalize (Object : in out Child_Iterator) is + procedure Finalize (Object : in out Root_Iterator) is B : Natural renames Object.Container.Busy; begin B := B - 1; @@ -943,14 +946,18 @@ package body Ada.Containers.Multiway_Trees is -- 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 @@ package body Ada.Containers.Multiway_Trees is 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; + begin + return Iterate_Subtree (Root (Container)); end Iterate; ---------------------- @@ -1464,9 +1461,9 @@ package body Ada.Containers.Multiway_Trees is 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 @@ package body Ada.Containers.Multiway_Trees is (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 @@ package body Ada.Containers.Multiway_Trees is 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 @@ package body Ada.Containers.Multiway_Trees is ---------- 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 sibling is present, return it - - if N.Next /= null 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 - 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. + if Position.Container = null then + return No_Element; + end if; - elsif Par = Object.Position.Node - and then not Object.From_Root - then - return No_Element; + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Next designates wrong tree"; + end if; - else - Par := Par.Parent; - end if; - end loop; + Node := Position.Node; - if Par = Object.Position.Node - and then not Object.From_Root - then - return No_Element; - end if; + if Node.Children.First /= null then + return Cursor'(Object.Container, Node.Children.First); + 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 -- cgit v1.1