Skip to content

R
riscv-gcc-1
Commit 993f8920 by Arnaud Charlet
Options

[multiple changes] 

2011-08-05  Matthew Heaney  <heaney@adacore.com>

	* a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Child_Count, Child_Depth):
	subprogram bodies declared out-of-order.

2011-08-05  Yannick Moy  <moy@adacore.com>

	* sem_util.adb (Unique_Name): only prefix with "standard" the names of
	entities directly in package Standard, otherwise skip the standard
	prefix.

From-SVN: r177461
parent 9b3956dd
Showing with 250 additions and 216 deletions
gcc/ada/ChangeLog
2011-08-05 Matthew Heaney <heaney@adacore.com>
* a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Child_Count, Child_Depth):
subprogram bodies declared out-of-order.
2011-08-05 Yannick Moy <moy@adacore.com>
* sem_util.adb (Unique_Name): only prefix with "standard" the names of
entities directly in package Standard, otherwise skip the standard
prefix.
2011-08-05 Robert Dewar <dewar@adacore.com>
* a-cbmutr.adb: Minor reformatting
......
gcc/ada/a-cbmutr.adb
......@@ -427,6 +427,86 @@ package body Ada.Containers.Bounded_Multiway_Trees is
Target.Count := Source.Count;
end Assign;
-----------------
-- Child_Count --
-----------------
function Child_Count (Parent : Cursor) return Count_Type is
begin
if Parent = No_Element then
return 0;
end if;
if Parent.Container.Count = 0 then
pragma Assert (Is_Root (Parent));
return 0;
end if;
return Child_Count (Parent.Container.all, Parent.Node);
end Child_Count;
function Child_Count
(Container : Tree;
Parent : Count_Type) return Count_Type
is
NN : Tree_Node_Array renames Container.Nodes;
CC : Children_Type renames NN (Parent).Children;
Result : Count_Type;
Node : Count_Type'Base;
begin
Result := 0;
Node := CC.First;
while Node > 0 loop
Result := Result + 1;
Node := NN (Node).Next;
end loop;
return Result;
end Child_Count;
-----------------
-- Child_Depth --
-----------------
function Child_Depth (Parent, Child : Cursor) return Count_Type is
Result : Count_Type;
N : Count_Type'Base;
begin
if Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
if Child = No_Element then
raise Constraint_Error with "Child cursor has no element";
end if;
if Parent.Container /= Child.Container then
raise Program_Error with "Parent and Child in different containers";
end if;
if Parent.Container.Count = 0 then
pragma Assert (Is_Root (Parent));
pragma Assert (Child = Parent);
return 0;
end if;
Result := 0;
N := Child.Node;
while N /= Parent.Node loop
Result := Result + 1;
N := Parent.Container.Nodes (N).Parent;
if N < 0 then
raise Program_Error with "Parent is not ancestor of Child";
end if;
end loop;
return Result;
end Child_Depth;
-----------
-- Clear --
-----------
......@@ -581,86 +661,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is
T_Node.Children := T_CC;
end Copy_Children;
-----------------
-- Child_Count --
-----------------
function Child_Count (Parent : Cursor) return Count_Type is
begin
if Parent = No_Element then
return 0;
end if;
if Parent.Container.Count = 0 then
pragma Assert (Is_Root (Parent));
return 0;
end if;
return Child_Count (Parent.Container.all, Parent.Node);
end Child_Count;
function Child_Count
(Container : Tree;
Parent : Count_Type) return Count_Type
is
NN : Tree_Node_Array renames Container.Nodes;
CC : Children_Type renames NN (Parent).Children;
Result : Count_Type;
Node : Count_Type'Base;
begin
Result := 0;
Node := CC.First;
while Node > 0 loop
Result := Result + 1;
Node := NN (Node).Next;
end loop;
return Result;
end Child_Count;
-----------------
-- Child_Depth --
-----------------
function Child_Depth (Parent, Child : Cursor) return Count_Type is
Result : Count_Type;
N : Count_Type'Base;
begin
if Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
if Child = No_Element then
raise Constraint_Error with "Child cursor has no element";
end if;
if Parent.Container /= Child.Container then
raise Program_Error with "Parent and Child in different containers";
end if;
if Parent.Container.Count = 0 then
pragma Assert (Is_Root (Parent));
pragma Assert (Child = Parent);
return 0;
end if;
Result := 0;
N := Child.Node;
while N /= Parent.Node loop
Result := Result + 1;
N := Parent.Container.Nodes (N).Parent;
if N < 0 then
raise Program_Error with "Parent is not ancestor of Child";
end if;
end loop;
return Result;
end Child_Depth;
------------------
-- Copy_Subtree --
------------------
......
gcc/ada/a-cimutr.adb
......@@ -295,6 +295,69 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
Target.Count := Source_Count;
end Assign;
-----------------
-- Child_Count --
-----------------
function Child_Count (Parent : Cursor) return Count_Type is
begin
if Parent = No_Element then
return 0;
end if;
return Child_Count (Parent.Node.Children);
end Child_Count;
function Child_Count (Children : Children_Type) return Count_Type is
Result : Count_Type;
Node : Tree_Node_Access;
begin
Result := 0;
Node := Children.First;
while Node /= null loop
Result := Result + 1;
Node := Node.Next;
end loop;
return Result;
end Child_Count;
-----------------
-- Child_Depth --
-----------------
function Child_Depth (Parent, Child : Cursor) return Count_Type is
Result : Count_Type;
N : Tree_Node_Access;
begin
if Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
if Child = No_Element then
raise Constraint_Error with "Child cursor has no element";
end if;
if Parent.Container /= Child.Container then
raise Program_Error with "Parent and Child in different containers";
end if;
Result := 0;
N := Child.Node;
while N /= Parent.Node loop
Result := Result + 1;
N := N.Parent;
if N = null then
raise Program_Error with "Parent is not ancestor of Child";
end if;
end loop;
return Result;
end Child_Depth;
-----------
-- Clear --
-----------
......@@ -418,69 +481,6 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
Parent.Children := CC;
end Copy_Children;
-----------------
-- Child_Count --
-----------------
function Child_Count (Parent : Cursor) return Count_Type is
begin
if Parent = No_Element then
return 0;
end if;
return Child_Count (Parent.Node.Children);
end Child_Count;
function Child_Count (Children : Children_Type) return Count_Type is
Result : Count_Type;
Node : Tree_Node_Access;
begin
Result := 0;
Node := Children.First;
while Node /= null loop
Result := Result + 1;
Node := Node.Next;
end loop;
return Result;
end Child_Count;
-----------------
-- Child_Depth --
-----------------
function Child_Depth (Parent, Child : Cursor) return Count_Type is
Result : Count_Type;
N : Tree_Node_Access;
begin
if Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
if Child = No_Element then
raise Constraint_Error with "Child cursor has no element";
end if;
if Parent.Container /= Child.Container then
raise Program_Error with "Parent and Child in different containers";
end if;
Result := 0;
N := Child.Node;
while N /= Parent.Node loop
Result := Result + 1;
N := N.Parent;
if N = null then
raise Program_Error with "Parent is not ancestor of Child";
end if;
end loop;
return Result;
end Child_Depth;
------------------
-- Copy_Subtree --
------------------
......
gcc/ada/a-comutr.adb
......@@ -291,6 +291,69 @@ package body Ada.Containers.Multiway_Trees is
Target.Count := Source_Count;
end Assign;
-----------------
-- Child_Count --
-----------------
function Child_Count (Parent : Cursor) return Count_Type is
begin
if Parent = No_Element then
return 0;
end if;
return Child_Count (Parent.Node.Children);
end Child_Count;
function Child_Count (Children : Children_Type) return Count_Type is
Result : Count_Type;
Node : Tree_Node_Access;
begin
Result := 0;
Node := Children.First;
while Node /= null loop
Result := Result + 1;
Node := Node.Next;
end loop;
return Result;
end Child_Count;
-----------------
-- Child_Depth --
-----------------
function Child_Depth (Parent, Child : Cursor) return Count_Type is
Result : Count_Type;
N : Tree_Node_Access;
begin
if Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
if Child = No_Element then
raise Constraint_Error with "Child cursor has no element";
end if;
if Parent.Container /= Child.Container then
raise Program_Error with "Parent and Child in different containers";
end if;
Result := 0;
N := Child.Node;
while N /= Parent.Node loop
Result := Result + 1;
N := N.Parent;
if N = null then
raise Program_Error with "Parent is not ancestor of Child";
end if;
end loop;
return Result;
end Child_Depth;
-----------
-- Clear --
-----------
......@@ -413,69 +476,6 @@ package body Ada.Containers.Multiway_Trees is
Parent.Children := CC;
end Copy_Children;
-----------------
-- Child_Count --
-----------------
function Child_Count (Parent : Cursor) return Count_Type is
begin
if Parent = No_Element then
return 0;
end if;
return Child_Count (Parent.Node.Children);
end Child_Count;
function Child_Count (Children : Children_Type) return Count_Type is
Result : Count_Type;
Node : Tree_Node_Access;
begin
Result := 0;
Node := Children.First;
while Node /= null loop
Result := Result + 1;
Node := Node.Next;
end loop;
return Result;
end Child_Count;
-----------------
-- Child_Depth --
-----------------
function Child_Depth (Parent, Child : Cursor) return Count_Type is
Result : Count_Type;
N : Tree_Node_Access;
begin
if Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
if Child = No_Element then
raise Constraint_Error with "Child cursor has no element";
end if;
if Parent.Container /= Child.Container then
raise Program_Error with "Parent and Child in different containers";
end if;
Result := 0;
N := Child.Node;
while N /= Parent.Node loop
Result := Result + 1;
N := N.Parent;
if N = null then
raise Program_Error with "Parent is not ancestor of Child";
end if;
end loop;
return Result;
end Child_Depth;
------------------
-- Copy_Subtree --
------------------
......
gcc/ada/sem_util.adb
......@@ -12357,14 +12357,37 @@ package body Sem_Util is
-----------------
function Unique_Name (E : Entity_Id) return String is
Name : constant String := Get_Name_String (Chars (E));
function Get_Scoped_Name (E : Entity_Id) return String;
-- Return the name of E prefixed by all the names of the scopes to which
-- E belongs, except for Standard.
---------------------
-- Get_Scoped_Name --
---------------------
function Get_Scoped_Name (E : Entity_Id) return String is
Name : constant String := Get_Name_String (Chars (E));
begin
if Has_Fully_Qualified_Name (E)
or else Scope (E) = Standard_Standard
then
return Name;
else
return Get_Scoped_Name (Scope (E)) & "__" & Name;
end if;
end Get_Scoped_Name;
begin
if Has_Fully_Qualified_Name (E)
or else E = Standard_Standard
then
return Name;
if E = Standard_Standard then
return Get_Name_String (Name_Standard);
elsif Scope (E) = Standard_Standard then
return Get_Name_String (Name_Standard) & "__" &
Get_Name_String (Chars (E));
else
return Unique_Name (Scope (E)) & "__" & Name;
return Get_Scoped_Name (E);
end if;
end Unique_Name;
......@@ -12478,7 +12501,7 @@ package body Sem_Util is
-- Start of processing for Unit_Is_Visible
begin
-- The currrent unit is directly visible.
-- The currrent unit is directly visible
if Curr = U then
return True;
......@@ -12486,7 +12509,7 @@ package body Sem_Util is
elsif Unit_In_Context (Curr) then
return True;
-- If the current unit is a body, check the context of the spec.
-- If the current unit is a body, check the context of the spec
elsif Nkind (Unit (Curr)) = N_Package_Body
or else
......@@ -12498,7 +12521,7 @@ package body Sem_Util is
end if;
end if;
-- If the spec is a child unit, examine the parents.
-- If the spec is a child unit, examine the parents
if Is_Child_Unit (Curr_Entity) then
if Nkind (Unit (Curr)) in N_Unit_Body then
......@@ -12670,7 +12693,7 @@ package body Sem_Util is
if Comes_From_Source (Expec_Type) then
Matching_Field := Expec_Type;
-- For an assignment, use name of target.
-- For an assignment, use name of target
elsif Nkind (Parent (Expr)) = N_Assignment_Statement
and then Is_Entity_Name (Name (Parent (Expr)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment