summaryrefslogtreecommitdiff
path: root/gcc/ada/sem_ch8.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/sem_ch8.adb')
-rw-r--r--gcc/ada/sem_ch8.adb118
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);