+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
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 --
-----------
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 --
------------------
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 --
-----------
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 --
------------------
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 --
-----------
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 --
------------------
-----------------
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;
-- 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;
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
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
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)))
projects / gcc.git / commitdiff