+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
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;
(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 --
-----------------------
-- 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;
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;
-----------------
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;
----------------------
return It : constant Child_Iterator :=
Child_Iterator'(Limited_Controlled with
Container => C,
- Parent => Parent.Node)
+ Subtree => Parent.Node)
do
B := B + 1;
end return;
(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
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;
----------------
-- 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
"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;
private
use Ada.Streams;
+ No_Node : constant Count_Type'Base := -1;
+
type Children_Type is record
First : Count_Type'Base;
Last : Count_Type'Base;
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;
type Cursor is record
Container : Tree_Access;
- Node : Count_Type'Base := -1;
+ Node : Count_Type'Base := No_Node;
end record;
procedure Read
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 --
-----------------------
-- 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;
-- 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;
-----------------
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;
----------------------
return It : constant Child_Iterator :=
Child_Iterator'(Limited_Controlled with
Container => C,
- Parent => Parent.Node)
+ Subtree => Parent.Node)
do
B := B + 1;
end return;
(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
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;
----------------
----------
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
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 --
-----------------------
-- 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;
-- 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;
-----------------
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;
----------------------
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;
(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
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;
----------------
----------
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
-- --
-- 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- --
-- 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;
-- 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
-- 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
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
if Ekind (E) /= E_Variable then
Ent := First_Entity (E);
while Present (Ent) loop
+ Reset_Buffers;
Qualify_Entity_Name (Ent);
Next_Entity (Ent);
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)
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 --
--------------------
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.
elsif Ekind (E) = E_Incomplete_Type
and then No (Underlying_Type (E))
+ and then not Is_Generic_Type (E)
then
Post_Error;
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));
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 " &
projects / gcc.git / commitdiff