diff options
Diffstat (limited to 'gcc/ada/sem_ch8.adb')
-rw-r--r-- | gcc/ada/sem_ch8.adb | 118 |
1 files changed, 110 insertions, 8 deletions
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 03529634ae5..518179d8587 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -428,6 +428,10 @@ package body Sem_Ch8 is -- Find a type derived from Character or Wide_Character in the prefix of N. -- Used to resolved qualified names whose selector is a character literal. + function Has_Private_With (E : Entity_Id) return Boolean; + -- Ada 0Y (AI-262): Determines if the current compilation unit has a + -- private with on E + procedure Find_Expanded_Name (N : Node_Id); -- Selected component is known to be expanded name. Verify legality -- of selector given the scope denoted by prefix. @@ -685,8 +689,7 @@ package body Sem_Ch8 is -- Ada 0Y (AI-230/AI-254): Access renaming - elsif Present (Access_Definition (N)) then - + else pragma Assert (Present (Access_Definition (N))); T := Access_Definition (Related_Nod => N, N => Access_Definition (N)); @@ -706,9 +709,6 @@ package body Sem_Ch8 is Error_Msg_N ("(Ada 0Y): null-excluding attribute ignored " & "('R'M 8.5.1(6))?", N); end if; - else - pragma Assert (False); - null; end if; -- An object renaming requires an exact match of the type; @@ -2406,6 +2406,11 @@ package body Sem_Ch8 is -- user point of view to warrant an error message of "not visible" -- rather than undefined. + Nvis_Is_Private_Subprg : Boolean := False; + -- Ada 0Y (AI-262): Set True to indicate that a form of Beaujolais + -- effect concerning library subprograms has been detected. Used to + -- generate the precise error message. + function From_Actual_Package (E : Entity_Id) return Boolean; -- Returns true if the entity is declared in a package that is -- an actual for a formal package of the current instance. Such an @@ -2566,10 +2571,46 @@ package body Sem_Ch8 is ------------------- procedure Nvis_Messages is - Ent : Entity_Id; - Hidden : Boolean := False; + Comp_Unit : Node_Id; + Ent : Entity_Id; + Hidden : Boolean := False; + Item : Node_Id; begin + -- Ada 0Y (AI-262): Generate a precise error concerning the + -- Beaujolais effect that was previously detected + + if Nvis_Is_Private_Subprg then + + pragma Assert (Nkind (E2) = N_Defining_Identifier + and then Ekind (E2) = E_Function + and then Scope (E2) = Standard_Standard + and then Has_Private_With (E2)); + + -- Find the sloc corresponding to the private with'ed unit + + Comp_Unit := Cunit (Current_Sem_Unit); + Item := First (Context_Items (Comp_Unit)); + Error_Msg_Sloc := No_Location; + + while Present (Item) loop + if Nkind (Item) = N_With_Clause + and then Private_Present (Item) + and then Entity (Name (Item)) = E2 + then + Error_Msg_Sloc := Sloc (Item); + exit; + end if; + + Next (Item); + end loop; + + pragma Assert (Error_Msg_Sloc /= No_Location); + + Error_Msg_N ("(Ada 0Y): hidden by private with clause #", N); + return; + end if; + Undefined (Nvis => True); if Msg then @@ -2949,6 +2990,29 @@ package body Sem_Ch8 is elsif Is_Potentially_Use_Visible (E2) then Only_One_Visible := False; All_Overloadable := All_Overloadable and Is_Overloadable (E2); + + -- Ada 0Y (AI-262): Protect against a form of Beujolais effect + -- that can occurr in private_with clauses. Example: + + -- with A; + -- private with B; package A is + -- package C is function B return Integer; + -- use A; end A; + -- V1 : Integer := B; + -- private function B return Integer; + -- V2 : Integer := B; + -- end C; + + -- V1 resolves to A.B, but V2 resolves to library unit B. + + elsif Ekind (E2) = E_Function + and then Scope (E2) = Standard_Standard + and then Has_Private_With (E2) + then + Only_One_Visible := False; + All_Overloadable := False; + Nvis_Is_Private_Subprg := True; + exit; end if; E2 := Homonym (E2); @@ -4433,6 +4497,30 @@ package body Sem_Ch8 is return Found; end Has_Implicit_Character_Literal; + ---------------------- + -- Has_Private_With -- + ---------------------- + + function Has_Private_With (E : Entity_Id) return Boolean is + Comp_Unit : constant Node_Id := Cunit (Current_Sem_Unit); + Item : Node_Id; + + begin + Item := First (Context_Items (Comp_Unit)); + while Present (Item) loop + if Nkind (Item) = N_With_Clause + and then Private_Present (Item) + and then Entity (Name (Item)) = E + then + return True; + end if; + + Next (Item); + end loop; + + return False; + end Has_Private_With; + --------------------------- -- Has_Implicit_Operator -- --------------------------- @@ -5356,6 +5444,7 @@ package body Sem_Ch8 is Prev : Entity_Id; Current_Instance : Entity_Id := Empty; Real_P : Entity_Id; + Private_With_OK : Boolean := False; begin if Ekind (P) /= E_Package then @@ -5396,12 +5485,25 @@ package body Sem_Ch8 is Real_P := P; end if; + -- Ada 0Y (AI-262): Check the use_clause of a private withed package + -- found in the private part of a package specification + + if In_Private_Part (Current_Scope) + and then Has_Private_With (P) + and then Is_Child_Unit (Current_Scope) + and then Is_Child_Unit (P) + and then Is_Ancestor_Package (Scope (Current_Scope), P) + then + Private_With_OK := True; + end if; + -- Loop through entities in one package making them potentially -- use-visible. Id := First_Entity (P); while Present (Id) - and then Id /= First_Private_Entity (P) + and then (Id /= First_Private_Entity (P) + or else Private_With_OK) -- Ada 0Y (AI-262) loop Prev := Current_Entity (Id); |