summaryrefslogtreecommitdiff
path: root/gcc
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
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')
-rw-r--r--gcc/ada/ChangeLog44
-rw-r--r--gcc/ada/a-cbmutr.adb187
-rw-r--r--gcc/ada/a-cbmutr.ads6
-rw-r--r--gcc/ada/a-cimutr.adb170
-rw-r--r--gcc/ada/a-comutr.adb173
-rw-r--r--gcc/ada/exp_dbug.adb39
-rw-r--r--gcc/ada/gnat_rm.texi6
-rw-r--r--gcc/ada/sem_ch3.adb1
-rw-r--r--gcc/ada/sem_util.adb8
-rw-r--r--gcc/ada/usage.adb4
10 files changed, 327 insertions, 311 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9ad5b1be173..3c668004cd5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,47 @@
+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.
+
2011-12-02 Thomas Quinot <quinot@adacore.com>
* sem_ch10.adb (Analyze_Compilation_Unit): For a library subprogram
diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb
index aee67f02a2f..713e1be8d4b 100644
--- a/gcc/ada/a-cbmutr.adb
+++ b/gcc/ada/a-cbmutr.adb
@@ -33,32 +33,37 @@ with System; use type System.Address;
package body Ada.Containers.Bounded_Multiway_Trees is
- No_Node : constant Count_Type'Base := -1;
+ --------------------
+ -- Root_Iterator --
+ --------------------
- type Iterator is new Limited_Controlled and
+ 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 : Count_Type;
end record;
- overriding procedure Finalize (Object : in out Iterator);
+ overriding procedure Finalize (Object : in out Root_Iterator);
+
+ -----------------------
+ -- Subtree_Iterator --
+ -----------------------
+
+ type Subtree_Iterator is new Root_Iterator with null record;
- overriding function First (Object : Iterator) return Cursor;
+ overriding function First (Object : Subtree_Iterator) return Cursor;
overriding function Next
- (Object : Iterator;
+ (Object : Subtree_Iterator;
Position : Cursor) return Cursor;
- type Child_Iterator is new Limited_Controlled and
- Tree_Iterator_Interfaces.Reversible_Iterator with
- record
- Container : Tree_Access;
- Parent : Count_Type;
- end record;
+ ---------------------
+ -- Child_Iterator --
+ ---------------------
- overriding procedure Finalize (Object : in out 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;
@@ -66,12 +71,12 @@ package body Ada.Containers.Bounded_Multiway_Trees is
(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 --
-----------------------
@@ -1242,13 +1247,7 @@ package body Ada.Containers.Bounded_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;
@@ -1278,14 +1277,22 @@ package body Ada.Containers.Bounded_Multiway_Trees is
return Cursor'(Container'Unrestricted_Access, Node);
end Find;
- function First (Object : Iterator) return Cursor is
+ -----------
+ -- First --
+ -----------
+
+ 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;
-----------------
@@ -1780,19 +1787,8 @@ package body Ada.Containers.Bounded_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;
+ return Iterate_Subtree (Root (Container));
end Iterate;
----------------------
@@ -1879,7 +1875,7 @@ package body Ada.Containers.Bounded_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;
@@ -1893,17 +1889,25 @@ package body Ada.Containers.Bounded_Multiway_Trees is
(Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
- B : Natural renames Position.Container.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
@@ -1962,7 +1966,7 @@ package body Ada.Containers.Bounded_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;
----------------
@@ -2023,67 +2027,43 @@ package body Ada.Containers.Bounded_Multiway_Trees is
-- Next --
----------
- function Next
- (Object : Iterator;
+ overriding function Next
+ (Object : Subtree_Iterator;
Position : Cursor) return Cursor
is
- T : Tree renames Position.Container.all;
- NN : Tree_Node_Array renames T.Nodes;
- N : Tree_Node_Type renames NN (Position.Node);
-
begin
- if Is_Leaf (Position) then
-
- -- If sibling is present, return it
-
- if N.Next /= 0 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
- Pos : Count_Type := N.Parent;
- Par : Tree_Node_Type := NN (Pos);
-
- begin
- while Par.Next = 0 loop
- Pos := Par.Parent;
-
- -- If we are back at the root the iteration is complete
-
- if Pos = No_Node 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 Pos = 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 := NN (Pos);
- end if;
- end loop;
+ pragma Assert (Object.Container.Count > 0);
+ pragma Assert (Position.Node /= Root_Node (Object.Container.all));
- if Pos = Object.Position.Node
- and then not Object.From_Root
- then
- return No_Element;
- end if;
+ declare
+ Nodes : Tree_Node_Array renames Object.Container.Nodes;
+ Node : Count_Type;
+ begin
+ Node := Position.Node;
- return (Object.Container, Par.Next);
- end;
+ if Nodes (Node).Children.First > 0 then
+ return Cursor'(Object.Container, Nodes (Node).Children.First);
end if;
- -- If an internal node, return its first child
+ while Node /= Object.Subtree loop
+ if Nodes (Node).Next > 0 then
+ return Cursor'(Object.Container, Nodes (Node).Next);
+ end if;
- else
- return (Object.Container, N.Children.First);
- end if;
+ Node := Nodes (Node).Parent;
+ end loop;
+
+ return No_Element;
+ end;
end Next;
overriding function Next
@@ -2100,6 +2080,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is
"Position cursor of Next designates wrong tree";
end if;
+ pragma Assert (Object.Container.Count > 0);
+ pragma Assert (Position.Node /= Root_Node (Object.Container.all));
+
return Next_Sibling (Position);
end Next;
diff --git a/gcc/ada/a-cbmutr.ads b/gcc/ada/a-cbmutr.ads
index 797b6ea6214..73580d992cf 100644
--- a/gcc/ada/a-cbmutr.ads
+++ b/gcc/ada/a-cbmutr.ads
@@ -301,6 +301,8 @@ package Ada.Containers.Bounded_Multiway_Trees is
private
use Ada.Streams;
+ No_Node : constant Count_Type'Base := -1;
+
type Children_Type is record
First : Count_Type'Base;
Last : Count_Type'Base;
@@ -319,7 +321,7 @@ private
type Tree (Capacity : Count_Type) is tagged record
Nodes : Tree_Node_Array (0 .. Capacity) := (others => <>);
Elements : Element_Array (1 .. Capacity) := (others => <>);
- Free : Count_Type'Base := -1;
+ Free : Count_Type'Base := No_Node;
Busy : Integer := 0;
Lock : Integer := 0;
Count : Count_Type := 0;
@@ -342,7 +344,7 @@ private
type Cursor is record
Container : Tree_Access;
- Node : Count_Type'Base := -1;
+ Node : Count_Type'Base := No_Node;
end record;
procedure Read
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
diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb
index b18b15f7534..12d675ad574 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
diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb
index ca36f14ad87..5d605d75c50 100644
--- a/gcc/ada/exp_dbug.adb
+++ b/gcc/ada/exp_dbug.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -105,11 +105,11 @@ package body Exp_Dbug is
-- Homonym_Suffix --
--------------------
- -- The string defined here (and its associated length) is used to
- -- gather the homonym string that will be appended to Name_Buffer
- -- when the name is complete. Strip_Suffixes appends to this string
- -- as does Append_Homonym_Number, and Output_Homonym_Numbers_Suffix
- -- appends the string to the end of Name_Buffer.
+ -- The string defined here (and its associated length) is used to gather
+ -- the homonym string that will be appended to Name_Buffer when the name
+ -- is complete. Strip_Suffixes appends to this string as does
+ -- Append_Homonym_Number, and Output_Homonym_Numbers_Suffix appends the
+ -- string to the end of Name_Buffer.
Homonym_Numbers : String (1 .. 256);
Homonym_Len : Natural := 0;
@@ -147,6 +147,10 @@ package body Exp_Dbug is
-- If not already done, replaces the Chars field of the given entity
-- with the appropriate fully qualified name.
+ procedure Reset_Buffers;
+ -- Reset the contents of Name_Buffer and Homonym_Numbers by setting their
+ -- respective lengths to zero.
+
procedure Strip_Suffixes (BNPE_Suffix_Found : in out Boolean);
-- Given an qualified entity name in Name_Buffer, remove any plain X or
-- X{nb} qualification suffix. The contents of Name_Buffer is not changed
@@ -701,8 +705,7 @@ package body Exp_Dbug is
-- Start of processing for Get_External_Name
begin
- Name_Len := 0;
- Homonym_Len := 0;
+ Reset_Buffers;
-- If this is a child unit, we want the child
@@ -1022,6 +1025,7 @@ package body Exp_Dbug is
begin
for J in Name_Qualify_Units.First .. Name_Qualify_Units.Last loop
E := Defining_Entity (Name_Qualify_Units.Table (J));
+ Reset_Buffers;
Qualify_Entity_Name (E);
-- Normally entities in the qualification list are scopes, but in the
@@ -1033,6 +1037,7 @@ package body Exp_Dbug is
if Ekind (E) /= E_Variable then
Ent := First_Entity (E);
while Present (Ent) loop
+ Reset_Buffers;
Qualify_Entity_Name (Ent);
Next_Entity (Ent);
@@ -1101,10 +1106,10 @@ package body Exp_Dbug is
if No (E) then
return;
- -- If this we are qualifying entities local to a generic
- -- instance, use the name of the original instantiation,
- -- not that of the anonymous subprogram in the wrapper
- -- package, so that gdb doesn't have to know about these.
+ -- If this we are qualifying entities local to a generic instance,
+ -- use the name of the original instantiation, not that of the
+ -- anonymous subprogram in the wrapper package, so that gdb doesn't
+ -- have to know about these.
elsif Is_Generic_Instance (E)
and then Is_Subprogram (E)
@@ -1394,6 +1399,16 @@ package body Exp_Dbug is
Name_Qualify_Units.Append (N);
end Qualify_Entity_Names;
+ -------------------
+ -- Reset_Buffers --
+ -------------------
+
+ procedure Reset_Buffers is
+ begin
+ Name_Len := 0;
+ Homonym_Len := 0;
+ end Reset_Buffers;
+
--------------------
-- Strip_Suffixes --
--------------------
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 8a51161a8fa..781e0ae6cc6 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -4953,12 +4953,14 @@ with this pragma and others compiled in normal mode without it.
Syntax:
@smallexample @c ada
-pragma Suppress_Initialization ([Entity =>] type_Name);
+pragma Suppress_Initialization ([Entity =>] subtype_Name);
@end smallexample
@noindent
+Here subtype_Name is the name introduced by a type declaration
+or subtype declaration.
This pragma suppresses any implicit or explicit initialization
-associated with the given type name for all variables of this type,
+for all variables of the given type or subtype,
including initialization resulting from the use of pragmas
Normalize_Scalars or Initialize_Scalars.
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index e708ee7d6f6..6af0ed53989 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9585,6 +9585,7 @@ package body Sem_Ch3 is
elsif Ekind (E) = E_Incomplete_Type
and then No (Underlying_Type (E))
+ and then not Is_Generic_Type (E)
then
Post_Error;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 203eec19a1d..b38536fb535 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -12210,10 +12210,18 @@ package body Sem_Util is
end loop;
end;
+ -- For a packed array type, we also need debug information for
+ -- the type used to represent the packed array. Conversely, we
+ -- also need it for the former if we need it for the latter.
+
if Is_Packed (T) then
Set_Debug_Info_Needed_If_Not_Set (Packed_Array_Type (T));
end if;
+ if Is_Packed_Array_Type (T) then
+ Set_Debug_Info_Needed_If_Not_Set (Original_Array_Type (T));
+ end if;
+
elsif Is_Access_Type (T) then
Set_Debug_Info_Needed_If_Not_Set (Directly_Designated_Type (T));
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 2c20136af7e..aa4b8156906 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -462,6 +462,10 @@ begin
Write_Line (" .m* turn on warnings for suspicious modulus value");
Write_Line (" .M turn off warnings for suspicious modulus value");
Write_Line (" n* normal warning mode (cancels -gnatws/-gnatwe)");
+ Write_Line (" .n turn on info messages for atomic " &
+ "synchronization");
+ Write_Line (" .N* turn off info messages for atomic " &
+ "synchronization");
Write_Line (" o* turn on warnings for address clause overlay");
Write_Line (" O turn off warnings for address clause overlay");
Write_Line (" .o turn on warnings for out parameters assigned " &