diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/ada/a-cbmutr.adb | 160 | ||||
| -rw-r--r-- | gcc/ada/a-cimutr.adb | 126 | ||||
| -rw-r--r-- | gcc/ada/a-comutr.adb | 126 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 43 |
5 files changed, 250 insertions, 216 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 68f4414..1dcb3eb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +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 diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb index b365d47..cc569e8 100644 --- a/gcc/ada/a-cbmutr.adb +++ b/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 -- ------------------ diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb index d5736fc..a7f16ae 100644 --- a/gcc/ada/a-cimutr.adb +++ b/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 -- ------------------ diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb index dfe50c1..f3c77ed 100644 --- a/gcc/ada/a-comutr.adb +++ b/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 -- ------------------ diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1ee06ba..f97dbb4 100644 --- a/gcc/ada/sem_util.adb +++ b/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))) |