diff options
Diffstat (limited to 'gcc/ada/sem_ch10.adb')
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 65 |
1 files changed, 53 insertions, 12 deletions
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index c6fa436ffb7..f8d93f36b9a 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -135,9 +135,15 @@ package body Sem_Ch10 is -- Place shadow entities for a limited_with package in the visibility -- structures for the current compilation. Implements Ada0Y (AI-50217). - procedure Install_Withed_Unit (With_Clause : Node_Id); + procedure Install_Withed_Unit + (With_Clause : Node_Id; + Private_With_OK : Boolean := False); + -- If the unit is not a child unit, make unit immediately visible. -- The caller ensures that the unit is not already currently installed. + -- The flag Private_With_OK is set true in Install_Private_With_Clauses, + -- which is called when compiling the private part of a package, or + -- installing the private declarations of a parent unit. procedure Install_Parents (Lib_Unit : Node_Id; Is_Private : Boolean); -- This procedure establishes the context for the compilation of a child @@ -2483,7 +2489,7 @@ package body Sem_Ch10 is P_Name : constant Entity_Id := Get_Parent_Entity (P_Unit); Withn : Node_Id; - function Build_Ancestor_Name (P : Node_Id) return Node_Id; + function Build_Ancestor_Name (P : Node_Id) return Node_Id; -- Build prefix of child unit name. Recurse if needed. function Build_Unit_Name return Node_Id; @@ -2497,7 +2503,6 @@ package body Sem_Ch10 is function Build_Ancestor_Name (P : Node_Id) return Node_Id is P_Ref : constant Node_Id := New_Reference_To (Defining_Entity (P), Loc); - begin if No (Parent_Spec (P)) then return P_Ref; @@ -2515,7 +2520,6 @@ package body Sem_Ch10 is function Build_Unit_Name return Node_Id is Result : Node_Id; - begin if No (Parent_Spec (P_Unit)) then return New_Reference_To (P_Name, Loc); @@ -2551,6 +2555,7 @@ package body Sem_Ch10 is if Is_Child_Spec (P_Unit) then Implicit_With_On_Parent (P_Unit, N); end if; + New_Nodes_OK := New_Nodes_OK - 1; end Implicit_With_On_Parent; @@ -2777,6 +2782,7 @@ package body Sem_Ch10 is if not (Private_Present (Parent (Lib_Spec))) then P_Name := Defining_Entity (P); Install_Private_Declarations (P_Name); + Install_Private_With_Clauses (P_Name); Set_Use (Private_Declarations (Specification (P))); end if; @@ -3134,10 +3140,34 @@ package body Sem_Ch10 is or else Private_Present (Parent (Lib_Unit)) then Install_Private_Declarations (P_Name); + Install_Private_With_Clauses (P_Name); Set_Use (Private_Declarations (P_Spec)); end if; end Install_Parents; + ---------------------------------- + -- Install_Private_With_Clauses -- + ---------------------------------- + + procedure Install_Private_With_Clauses (P : Entity_Id) is + Decl : constant Node_Id := Unit_Declaration_Node (P); + Clause : Node_Id; + + begin + if Nkind (Parent (Decl)) = N_Compilation_Unit then + Clause := First (Context_Items (Parent (Decl))); + while Present (Clause) loop + if Nkind (Clause) = N_With_Clause + and then Private_Present (Clause) + then + Install_Withed_Unit (Clause, Private_With_OK => True); + end if; + + Next (Clause); + end loop; + end if; + end Install_Private_With_Clauses; + ---------------------- -- Install_Siblings -- ---------------------- @@ -3161,11 +3191,9 @@ package body Sem_Ch10 is begin Par := U_Name; - while Present (Par) and then Par /= Standard_Standard loop - if Par = E then return True; end if; @@ -3183,9 +3211,7 @@ package body Sem_Ch10 is -- scope of each entity is an ancestor of the current unit. Item := First (Context_Items (N)); - while Present (Item) loop - if Nkind (Item) = N_With_Clause and then not Implicit_With (Item) and then not Limited_Present (Item) @@ -3235,7 +3261,6 @@ package body Sem_Ch10 is then Set_Is_Immediately_Visible (Scope (Id)); end if; - end if; Next (Item); @@ -3259,6 +3284,10 @@ package body Sem_Ch10 is -- Check that the shadow entity is not already in the homonym -- chain, for example through a limited_with clause in a parent unit. + -------------- + -- In_Chain -- + -------------- + function In_Chain (E : Entity_Id) return Boolean is H : Entity_Id := Current_Entity (E); @@ -3435,7 +3464,10 @@ package body Sem_Ch10 is -- Install_Withed_Unit -- ------------------------- - procedure Install_Withed_Unit (With_Clause : Node_Id) is + procedure Install_Withed_Unit + (With_Clause : Node_Id; + Private_With_OK : Boolean := False) + is Uname : constant Entity_Id := Entity (Name (With_Clause)); P : constant Entity_Id := Scope (Uname); @@ -3460,13 +3492,17 @@ package body Sem_Ch10 is end if; if P /= Standard_Standard then + if Private_Present (With_Clause) + and then not (Private_With_OK) + then + return; -- If the unit is not analyzed after analysis of the with clause, -- and it is an instantiation, then it awaits a body and is the main -- unit. Its appearance in the context of some other unit indicates -- a circular dependency (DEC suite perversity). - if not Analyzed (Uname) + elsif not Analyzed (Uname) and then Nkind (Parent (Uname)) = N_Package_Instantiation then Error_Msg_N @@ -3498,7 +3534,12 @@ package body Sem_Ch10 is end if; elsif not Is_Immediately_Visible (Uname) then - Set_Is_Immediately_Visible (Uname); + if not Private_Present (With_Clause) + or else Private_With_OK + then + Set_Is_Immediately_Visible (Uname); + end if; + Set_Context_Installed (With_Clause); end if; |