OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r181919
This commit is contained in:
Arnaud Charlet 2011-12-02 16:00:35 +01:00
parent 81435e80be
commit 0add5a9536
10 changed files with 329 additions and 313 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
gcc/ada/ChangeLog
View File

@ -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

187
gcc/ada/a-cbmutr.adb
View File

@ -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);
overriding function First (Object : Iterator) return Cursor;
-----------------------
-- Subtree_Iterator --
-----------------------
type Subtree_Iterator is new Root_Iterator with null record;
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 Position.Container = null then
return No_Element;
end if;
-- If sibling is present, return it
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong tree";
end if;
if N.Next /= 0 then
return (Object.Container, N.Next);
pragma Assert (Object.Container.Count > 0);
pragma Assert (Position.Node /= Root_Node (Object.Container.all));
-- If this is the last sibling, go to sibling of first ancestor that
-- has a sibling, or terminate.
declare
Nodes : Tree_Node_Array renames Object.Container.Nodes;
Node : Count_Type;
begin
Node := Position.Node;
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.
elsif Pos = Object.Position.Node
and then not Object.From_Root
then
return No_Element;
else
Par := NN (Pos);
end if;
end loop;
if Pos = Object.Position.Node
and then not Object.From_Root
then
return No_Element;
end if;
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;

6
gcc/ada/a-cbmutr.ads
View File

@ -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

172
gcc/ada/a-cimutr.adb
View File

@ -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 Previous
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;
-----------------------
-- 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;
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 Position.Container = null then
return No_Element;
end if;
-- If sibling is present, return it
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong tree";
end if;
if N.Next /= null then
return (Object.Container, N.Next);
Node := Position.Node;
-- If this is the last sibling, go to sibling of first ancestor that
-- has a sibling, or terminate.
if Node.Children.First /= null then
return Cursor'(Object.Container, Node.Children.First);
end if;
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.
elsif Par = Object.Position.Node
and then not Object.From_Root
then
return No_Element;
else
Par := Par.Parent;
end if;
end loop;
if Par = Object.Position.Node
and then not Object.From_Root
then
return No_Element;
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

175
gcc/ada/a-comutr.adb
View File

@ -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 Previous
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;
-----------------------
-- 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;
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 Position.Container = null then
return No_Element;
end if;
-- If sibling is present, return it
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong tree";
end if;
if N.Next /= null then
return (Object.Container, N.Next);
Node := Position.Node;
-- If this is the last sibling, go to sibling of first ancestor that
-- has a sibling, or terminate.
if Node.Children.First /= null then
return Cursor'(Object.Container, Node.Children.First);
end if;
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.
elsif Par = Object.Position.Node
and then not Object.From_Root
then
return No_Element;
else
Par := Par.Parent;
end if;
end loop;
if Par = Object.Position.Node
and then not Object.From_Root
then
return No_Element;
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

39
gcc/ada/exp_dbug.adb
View File

@ -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 --
--------------------

6
gcc/ada/gnat_rm.texi
View File

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

1
gcc/ada/sem_ch3.adb
View File

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

8
gcc/ada/sem_util.adb
View File

@ -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));

4
gcc/ada/usage.adb
View File

@ -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 " &