diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-12-02 15:00:35 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-12-02 15:00:35 +0000 |
commit | b38c243a8512e78989b7fe0c4bb1fb4ca53d784c (patch) | |
tree | 1b7415ab9e85093c20b13f4f8eb683950dce5ac4 /gcc/ada/a-cimutr.adb | |
parent | b987f1dbef95c2c653df8f41a11df1ef3a650fb6 (diff) | |
download | gcc-b38c243a8512e78989b7fe0c4bb1fb4ca53d784c.tar.gz |
2011-12-02 Hristian Kirtchev <kirtchev@adacore.com>
* 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 <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
2011-12-02 Robert Dewar <dewar@adacore.com>
* usage.adb: Add lines for -gnatw.n and -gnatw.N
(atomic sync info msgs).
2011-12-02 Steve Baird <baird@adacore.com>
* sem_ch3.adb (Check_Completion): An Ada 2012
generic formal type doesn't require a completion.
2011-12-02 Eric Botcazou <ebotcazou@adacore.com>
* 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 <dewar@adacore.com>
* gnat_rm.texi: Eliminate confusing use of type name.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181919 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/a-cimutr.adb')
-rw-r--r-- | gcc/ada/a-cimutr.adb | 170 |
1 files changed, 74 insertions, 96 deletions
diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb index 01929bbf373..daac18feb04 100644 --- a/gcc/ada/a-cimutr.adb +++ b/gcc/ada/a-cimutr.adb @@ -33,41 +33,50 @@ with System; use type System.Address; 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 -- + ----------------------- + + 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 -- ----------------------- @@ -936,13 +945,7 @@ package body Ada.Containers.Indefinite_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; @@ -971,14 +974,18 @@ package body Ada.Containers.Indefinite_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; ----------------- @@ -1348,18 +1355,8 @@ package body Ada.Containers.Indefinite_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; ---------------------- @@ -1438,7 +1435,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is 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 @@ package body Ada.Containers.Indefinite_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 @@ -1515,7 +1520,7 @@ package body Ada.Containers.Indefinite_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; ---------------- @@ -1585,63 +1590,36 @@ package body Ada.Containers.Indefinite_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; - -- 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 |