summaryrefslogtreecommitdiff
path: root/gcc/ada/a-cimutr.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-12-02 15:00:35 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-12-02 15:00:35 +0000
commitb38c243a8512e78989b7fe0c4bb1fb4ca53d784c (patch)
tree1b7415ab9e85093c20b13f4f8eb683950dce5ac4 /gcc/ada/a-cimutr.adb
parentb987f1dbef95c2c653df8f41a11df1ef3a650fb6 (diff)
downloadgcc-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.adb170
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