aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHristian Kirtchev <kirtchev@adacore.com>2018-05-24 13:06:05 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2018-05-24 13:06:05 +0000
commitdc59bed2859c3b713334e20623e47ec5aafd8f5d (patch)
treecc48b3130b914979bcc18f1c1005dac30ac11612
parent45c6d7849670dc3fd2dc4686c3c31dc6cb7bf49e (diff)
downloadgcc-dc59bed2859c3b713334e20623e47ec5aafd8f5d.zip
gcc-dc59bed2859c3b713334e20623e47ec5aafd8f5d.tar.gz
gcc-dc59bed2859c3b713334e20623e47ec5aafd8f5d.tar.bz2
[Ada] Spurious error due to lingering limited view
This patch modifies the mechanism which manages [private] with clauses to uninstall a limited with clause if a non-limited with clause is given for the same package. The management of with clauses already prevents the installation of a limited with clause if the related package is already withed though a non-limited with clause. The timing of parent unit with clause processing is such that the non- limited clauses of the child unit are first installed, followed by the clauses of the parent. This order prevents a limited with clause from "overriding" a non-limited with clause. Private with clauses however break this model because they are processed when the private part of a package is entered. Since private with clauses are non- limited with clauses, they must "override" the effects of any limited clauses which import the same packages. This effect is now correctly achieved by uninstalling the limited with clauses when private with clauses are activated. ------------ -- Source -- ------------ -- server.ads package Server is type Root is tagged private; private type Root is tagged null record; end Server; -- parent.ads limited with Server; package Parent is end Parent; -- parent-client.ads private with Server; package Parent.Client is type Deriv is tagged private; private type Deriv is new Server.Root with null record; end Parent.Client; ----------------- -- Compilation -- ----------------- $ gcc -c parent-client.ads 2018-05-24 Hristian Kirtchev <kirtchev@adacore.com> gcc/ada/ * sem_ch10.adb (Expand_Limited_With_Clause): Update the call to Install_Limited_Withed_Unit. (Expand_With_Clause): Update the call to Install_Withed_Unit. (Implicit_With_On_Parent): Update the call to Install_Withed_Unit. (Install_Context_Clauses): Update the call to Install_Withed_Unit. (Install_Limited_Context_Clauses): Update the calls to Install_Limited_Withed_Unit. (Install_Limited_Withed_Unit): Renamed to better illustrate its purpose. (Install_Private_With_Clauses): Update the calls to Install_Withed_Unit and Install_Limited_Withed_Unit. (Install_With_Clause): Uninstall a limited with clause if a [private] with clause is given for the same package. (Install_Withed_Unit): Renamed to better illustrate its purpose. (Remove_Limited_With_Unit): New routine. From-SVN: r260660
-rw-r--r--gcc/ada/ChangeLog18
-rw-r--r--gcc/ada/sem_ch10.adb437
2 files changed, 306 insertions, 149 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 32e4b6a..30f5cd6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2018-05-24 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch10.adb (Expand_Limited_With_Clause): Update the call to
+ Install_Limited_Withed_Unit.
+ (Expand_With_Clause): Update the call to Install_Withed_Unit.
+ (Implicit_With_On_Parent): Update the call to Install_Withed_Unit.
+ (Install_Context_Clauses): Update the call to Install_Withed_Unit.
+ (Install_Limited_Context_Clauses): Update the calls to
+ Install_Limited_Withed_Unit.
+ (Install_Limited_Withed_Unit): Renamed to better illustrate its
+ purpose.
+ (Install_Private_With_Clauses): Update the calls to Install_Withed_Unit
+ and Install_Limited_Withed_Unit.
+ (Install_With_Clause): Uninstall a limited with clause if a [private]
+ with clause is given for the same package.
+ (Install_Withed_Unit): Renamed to better illustrate its purpose.
+ (Remove_Limited_With_Unit): New routine.
+
2018-05-24 Eric Botcazou <ebotcazou@adacore.com>
* raise-gcc.c (__gnat_SEH_error_handler): Remove prototype.
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index ec8a651..357fbde 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -150,19 +150,10 @@ package body Sem_Ch10 is
-- Subsidiary to Install_Context. Process only limited with_clauses for
-- current unit. Implements Ada 2005 (AI-50217).
- procedure Install_Limited_Withed_Unit (N : Node_Id);
+ procedure Install_Limited_With_Clause (N : Node_Id);
-- Place shadow entities for a limited_with package in the visibility
-- structures for the current compilation. Implements Ada 2005 (AI-50217).
- 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;
@@ -185,6 +176,15 @@ package body Sem_Ch10 is
-- an enclosing scope. Iterate over context to find child units of U_Name
-- or of some ancestor of it.
+ procedure Install_With_Clause
+ (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.
+
function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean;
-- When compiling a unit Q descended from some parent unit P, a limited
-- with_clause in the context of P that names some other ancestor of Q
@@ -204,8 +204,15 @@ package body Sem_Ch10 is
-- Subsidiary of previous one. Remove use_ and with_clauses
procedure Remove_Limited_With_Clause (N : Node_Id);
- -- Remove from visibility the shadow entities introduced for a package
- -- mentioned in a limited_with clause. Implements Ada 2005 (AI-50217).
+ -- Remove the shadow entities from visibility introduced for a package
+ -- mentioned in limited with clause N. Implements Ada 2005 (AI-50217).
+
+ procedure Remove_Limited_With_Unit
+ (Pack_Decl : Node_Id;
+ Lim_Clause : Node_Id := Empty);
+ -- Remove the shadow entities from visibility introduced for a package
+ -- denoted by declaration Pack_Decl. Lim_Clause is the related limited
+ -- with clause, if any. Implements Ada 2005 (AI-50217).
procedure Remove_Parents (Lib_Unit : Node_Id);
-- Remove_Parents checks if Lib_Unit is a child spec. If so then the parent
@@ -248,7 +255,7 @@ package body Sem_Ch10 is
-- of the package. Links between corresponding entities in both chains
-- allow the compiler to select the proper view of a given type, depending
-- on the context. Note that in contrast with the handling of private
- -- types, the limited view and the non-limited view of a type are treated
+ -- types, the limited view and the nonlimited view of a type are treated
-- as separate entities, and no entity exchange needs to take place, which
-- makes the implementation much simpler than could be feared.
@@ -1387,7 +1394,7 @@ package body Sem_Ch10 is
-- Loop through actual context items. This is done in two passes:
- -- a) The first pass analyzes non-limited with-clauses and also any
+ -- a) The first pass analyzes nonlimited with clauses and also any
-- configuration pragmas (we need to get the latter analyzed right
-- away, since they can affect processing of subsequent items).
@@ -3182,7 +3189,8 @@ package body Sem_Ch10 is
Prepend (Withn, Context_Items (N));
Mark_Rewrite_Insertion (Withn);
- Install_Withed_Unit (Withn);
+
+ Install_With_Clause (Withn);
-- If we have "with X.Y;", we want to recurse on "X", except in the
-- unusual case where X.Y is a renaming of X. In that case, the scope
@@ -3395,7 +3403,8 @@ package body Sem_Ch10 is
Prepend (Withn, Context_Items (N));
Mark_Rewrite_Insertion (Withn);
- Install_Withed_Unit (Withn);
+
+ Install_With_Clause (Withn);
if Is_Child_Spec (P_Unit) then
Implicit_With_On_Parent (P_Unit, N);
@@ -3501,7 +3510,7 @@ package body Sem_Ch10 is
Check_Private := True;
end if;
- Install_Withed_Unit (Item);
+ Install_With_Clause (Item);
Decl_Node := Unit_Declaration_Node (Uname_Node);
@@ -3905,7 +3914,7 @@ package body Sem_Ch10 is
function Previous_Withed_Unit (W : Node_Id) return Boolean;
-- Returns true if the context already includes a with_clause for
- -- this unit. If the with_clause is non-limited, the unit is fully
+ -- this unit. If the with_clause is nonlimited, the unit is fully
-- visible and an implicit limited_with should not be created. If
-- there is already a limited_with clause for W, a second one is
-- simply redundant.
@@ -3992,7 +4001,7 @@ package body Sem_Ch10 is
Analyze (Withn);
if not Limited_View_Installed (Withn) then
- Install_Limited_Withed_Unit (Withn);
+ Install_Limited_With_Clause (Withn);
end if;
end if;
end Expand_Limited_With_Clause;
@@ -4039,7 +4048,7 @@ package body Sem_Ch10 is
N_Subprogram_Body,
N_Subunit)
then
- Install_Limited_Withed_Unit (Item);
+ Install_Limited_With_Clause (Item);
end if;
end if;
end if;
@@ -4075,12 +4084,12 @@ package body Sem_Ch10 is
if not Is_Incomplete_Type (Non_Lim_View) then
-- Convert an incomplete subtype declaration into a
- -- corresponding non-limited view subtype declaration.
+ -- corresponding nonlimited view subtype declaration.
-- This is usually the case when analyzing a body that
-- has regular with clauses, when the spec has limited
-- ones.
- -- If the non-limited view is still incomplete, it is
+ -- If the nonlimited view is still incomplete, it is
-- the dummy entry already created, and the declaration
-- cannot be reanalyzed. This is the case when installing
-- a parent unit that has limited with-clauses.
@@ -4262,10 +4271,10 @@ package body Sem_Ch10 is
not Is_Ancestor_Unit (Library_Unit (Item),
Cunit (Current_Sem_Unit))
then
- Install_Limited_Withed_Unit (Item);
+ Install_Limited_With_Clause (Item);
end if;
else
- Install_Withed_Unit (Item, Private_With_OK => True);
+ Install_With_Clause (Item, Private_With_OK => True);
end if;
end if;
@@ -4430,10 +4439,10 @@ package body Sem_Ch10 is
end Install_Siblings;
---------------------------------
- -- Install_Limited_Withed_Unit --
+ -- Install_Limited_With_Clause --
---------------------------------
- procedure Install_Limited_Withed_Unit (N : Node_Id) is
+ procedure Install_Limited_With_Clause (N : Node_Id) is
P_Unit : constant Entity_Id := Unit (Library_Unit (N));
E : Entity_Id;
P : Entity_Id;
@@ -4890,7 +4899,7 @@ package body Sem_Ch10 is
return False;
end Is_Visible_Through_Renamings;
- -- Start of processing for Install_Limited_Withed_Unit
+ -- Start of processing for Install_Limited_With_Clause
begin
pragma Assert (not Limited_View_Installed (N));
@@ -4951,7 +4960,7 @@ package body Sem_Ch10 is
-- compilation of sibling Par.Sib forces the load of parent Par which
-- tries to install the limited view of Lim_Pack [1]. However Par.Sib
-- has a with clause for Lim_Pack [2] in its body, and thus needs the
- -- non-limited views of all entities from Lim_Pack.
+ -- nonlimited views of all entities from Lim_Pack.
-- limited with Lim_Pack; -- [1]
-- package Par is ... package Lim_Pack is ...
@@ -5157,7 +5166,7 @@ package body Sem_Ch10 is
-- Replace E in the homonyms list, so that the limited view
-- becomes available.
- -- If the non-limited view is a record with an anonymous
+ -- If the nonlimited view is a record with an anonymous
-- self-referential component, the analysis of the record
-- declaration creates an incomplete type with the same name
-- in order to define an internal access type. The visible
@@ -5259,13 +5268,13 @@ package body Sem_Ch10 is
Set_Entity (Name (N), P);
Set_From_Limited_With (P);
- end Install_Limited_Withed_Unit;
+ end Install_Limited_With_Clause;
-------------------------
- -- Install_Withed_Unit --
+ -- Install_With_Clause --
-------------------------
- procedure Install_Withed_Unit
+ procedure Install_With_Clause
(With_Clause : Node_Id;
Private_With_OK : Boolean := False)
is
@@ -5378,11 +5387,21 @@ package body Sem_Ch10 is
Set_Context_Installed (With_Clause);
end if;
- -- A with-clause overrides a with-type clause: there are no restric-
- -- tions on the use of package entities.
-
- if Ekind (Uname) = E_Package then
- Set_From_Limited_With (Uname, False);
+ -- A [private] with clause overrides a limited with clause. Restore the
+ -- proper view of the package by performing the following actions:
+ --
+ -- * Remove all shadow entities which hide their corresponding
+ -- entities from direct visibility by updating the entity and
+ -- homonym chains.
+ --
+ -- * Enter the corresponding entities back in direct visibility
+ --
+ -- Note that the original limited with clause which installed its view
+ -- is still marked as "active". This effect is undone when the clause
+ -- itself is removed, see Remove_Limited_With_Clause.
+
+ if Ekind (Uname) = E_Package and then From_Limited_With (Uname) then
+ Remove_Limited_With_Unit (Unit_Declaration_Node (Uname));
end if;
-- Ada 2005 (AI-377): it is illegal for a with_clause to name a child
@@ -5454,7 +5473,7 @@ package body Sem_Ch10 is
end loop;
end;
end if;
- end Install_Withed_Unit;
+ end Install_With_Clause;
-------------------
-- Is_Child_Spec --
@@ -5994,9 +6013,10 @@ package body Sem_Ch10 is
Build_Shadow_Entity (Def_Id, Scop, Shadow);
Process_Declarations_And_States
- (Pack => Def_Id,
- Decls => Visible_Declarations (Specification (Decl)),
- Scop => Shadow,
+ (Pack => Def_Id,
+ Decls =>
+ Visible_Declarations (Specification (Decl)),
+ Scop => Shadow,
Create_Abstract_Views => Create_Abstract_Views);
-- Types
@@ -6166,9 +6186,9 @@ package body Sem_Ch10 is
-- variables and types.
Process_Declarations_And_States
- (Pack => Pack,
- Decls => Visible_Declarations (Spec),
- Scop => Pack,
+ (Pack => Pack,
+ Decls => Visible_Declarations (Spec),
+ Scop => Pack,
Create_Abstract_Views => True);
Last_Public_Shadow := Last_Shadow;
@@ -6177,9 +6197,9 @@ package body Sem_Ch10 is
-- to accommodate limited private with clauses.
Process_Declarations_And_States
- (Pack => Pack,
- Decls => Private_Declarations (Spec),
- Scop => Pack,
+ (Pack => Pack,
+ Decls => Private_Declarations (Spec),
+ Scop => Pack,
Create_Abstract_Views => False);
if Present (Last_Public_Shadow) then
@@ -6423,149 +6443,268 @@ package body Sem_Ch10 is
--------------------------------
procedure Remove_Limited_With_Clause (N : Node_Id) is
- P_Unit : constant Entity_Id := Unit (Library_Unit (N));
- E : Entity_Id;
- P : Entity_Id;
- Lim_Header : Entity_Id;
- Lim_Typ : Entity_Id;
- Prev : Entity_Id;
+ Pack_Decl : constant Entity_Id := Unit (Library_Unit (N));
begin
pragma Assert (Limited_View_Installed (N));
- -- In case of limited with_clause on subprograms, generics, instances,
- -- or renamings, the corresponding error was previously posted and we
- -- have nothing to do here.
+ -- Limited with clauses that designate units other than packages are
+ -- illegal and are never installed.
- if Nkind (P_Unit) /= N_Package_Declaration then
- return;
+ if Nkind (Pack_Decl) = N_Package_Declaration then
+ Remove_Limited_With_Unit (Pack_Decl, N);
end if;
- P := Defining_Unit_Name (Specification (P_Unit));
+ -- Indicate that the limited views of the clause have been removed
- -- Handle child packages
+ Set_Limited_View_Installed (N, False);
+ end Remove_Limited_With_Clause;
- if Nkind (P) = N_Defining_Program_Unit_Name then
- P := Defining_Identifier (P);
- end if;
+ ------------------------------
+ -- Remove_Limited_With_Unit --
+ ------------------------------
- if Debug_Flag_I then
- Write_Str ("remove limited view of ");
- Write_Name (Chars (P));
- Write_Str (" from visibility");
- Write_Eol;
- end if;
+ procedure Remove_Limited_With_Unit
+ (Pack_Decl : Node_Id;
+ Lim_Clause : Node_Id := Empty)
+ is
+ procedure Remove_Shadow_Entities_From_Visibility (Pack_Id : Entity_Id);
+ -- Remove the shadow entities of package Pack_Id from direct visibility
- -- Prepare the removal of the shadow entities from visibility. The first
- -- element of the limited view is a header (an E_Package entity) that is
- -- used to reference the first shadow entity in the private part of the
- -- package
+ procedure Remove_Shadow_Entities_With_Restore (Pack_Id : Entity_Id);
+ -- Remove the shadow entities of package Pack_Id from direct visibility,
+ -- restore the corresponding entities they hide into direct visibility,
+ -- and update the entity and homonym chains.
- Lim_Header := Limited_View (P);
- Lim_Typ := First_Entity (Lim_Header);
+ --------------------------------------------
+ -- Remove_Shadow_Entities_From_Visibility --
+ --------------------------------------------
- -- Remove package and shadow entities from visibility if it has not
- -- been analyzed
+ procedure Remove_Shadow_Entities_From_Visibility (Pack_Id : Entity_Id) is
+ Lim_Header : constant Entity_Id := Limited_View (Pack_Id);
+ Upto : constant Entity_Id := First_Private_Entity (Lim_Header);
- if not Analyzed (P_Unit) then
- Unchain (P);
- Set_Is_Immediately_Visible (P, False);
+ Shadow : Entity_Id;
- while Present (Lim_Typ) loop
- Unchain (Lim_Typ);
- Next_Entity (Lim_Typ);
+ begin
+ -- Remove the package from direct visibility
+
+ Unchain (Pack_Id);
+ Set_Is_Immediately_Visible (Pack_Id, False);
+
+ -- Remove all shadow entities from direct visibility
+
+ Shadow := First_Entity (Lim_Header);
+ while Present (Shadow) and then Shadow /= Upto loop
+ Unchain (Shadow);
+ Next_Entity (Shadow);
end loop;
+ end Remove_Shadow_Entities_From_Visibility;
- -- Otherwise this package has already appeared in the closure and its
- -- shadow entities must be replaced by its real entities. This code
- -- must be kept synchronized with the complementary code in Install
- -- Limited_Withed_Unit.
+ -----------------------------------------
+ -- Remove_Shadow_Entities_With_Restore --
+ -----------------------------------------
- else
- -- If the limited_with_clause is in some other unit in the context
- -- then it is not visible in the main unit.
+ procedure Remove_Shadow_Entities_With_Restore (Pack_Id : Entity_Id) is
+ procedure Restore_Chain_For_Shadow (Shadow : Entity_Id);
+ -- Remove shadow entity Shadow by updating the entity and homonym
+ -- chains.
- if not In_Extended_Main_Source_Unit (N) then
- Set_Is_Immediately_Visible (P, False);
- end if;
+ procedure Restore_Chains
+ (From : Entity_Id;
+ Upto : Entity_Id);
+ -- Remove a sequence of shadow entities starting from From and ending
+ -- prior to Upto by updating the entity and homonym chains.
- -- Real entities that are type or subtype declarations were hidden
- -- from visibility at the point of installation of the limited-view.
- -- Now we recover the previous value of the hidden attribute.
+ procedure Restore_Type_Visibility
+ (From : Entity_Id;
+ Upto : Entity_Id);
+ -- Restore a sequence of types starting from From and ending prior to
+ -- Upto back in direct visibility.
- E := First_Entity (P);
- while Present (E) and then E /= First_Private_Entity (P) loop
- if Is_Type (E) then
- Set_Is_Hidden (E, Was_Hidden (E));
+ ------------------------------
+ -- Restore_Chain_For_Shadow --
+ ------------------------------
+
+ procedure Restore_Chain_For_Shadow (Shadow : Entity_Id) is
+ Prev : Entity_Id;
+ Typ : Entity_Id;
+
+ begin
+ -- If the package has incomplete types, the limited view of the
+ -- incomplete type is in fact never visible (AI05-129) but we
+ -- have created a shadow entity E1 for it, that points to E2,
+ -- a nonlimited incomplete type. This in turn has a full view
+ -- E3 that is the full declaration. There is a corresponding
+ -- shadow entity E4. When reinstalling the nonlimited view,
+ -- E2 must become the current entity and E3 must be ignored.
+
+ Typ := Non_Limited_View (Shadow);
+
+ -- Shadow is the limited view of a full type declaration that has
+ -- a previous incomplete declaration, i.e. E3 from the previous
+ -- description. Nothing to insert.
+
+ if Present (Current_Entity (Typ))
+ and then Ekind (Current_Entity (Typ)) = E_Incomplete_Type
+ and then Full_View (Current_Entity (Typ)) = Typ
+ then
+ return;
end if;
- Next_Entity (E);
- end loop;
+ pragma Assert (not In_Chain (Typ));
- while Present (Lim_Typ)
- and then Lim_Typ /= First_Private_Entity (Lim_Header)
- loop
- -- Nested packages and child units were not unchained
+ Prev := Current_Entity (Shadow);
- if Ekind (Lim_Typ) /= E_Package
- and then not Is_Child_Unit (Non_Limited_View (Lim_Typ))
- then
- -- If the package has incomplete types, the limited view of the
- -- incomplete type is in fact never visible (AI05-129) but we
- -- have created a shadow entity E1 for it, that points to E2,
- -- a non-limited incomplete type. This in turn has a full view
- -- E3 that is the full declaration. There is a corresponding
- -- shadow entity E4. When reinstalling the non-limited view,
- -- E2 must become the current entity and E3 must be ignored.
-
- E := Non_Limited_View (Lim_Typ);
-
- if Present (Current_Entity (E))
- and then Ekind (Current_Entity (E)) = E_Incomplete_Type
- and then Full_View (Current_Entity (E)) = E
- then
+ if Prev = Shadow then
+ Set_Current_Entity (Typ);
+
+ else
+ while Present (Prev) and then Homonym (Prev) /= Shadow loop
+ Prev := Homonym (Prev);
+ end loop;
+
+ if Present (Prev) then
+ Set_Homonym (Prev, Typ);
+ end if;
+ end if;
+
+ Set_Homonym (Typ, Homonym (Shadow));
+ end Restore_Chain_For_Shadow;
+
+ --------------------
+ -- Restore_Chains --
+ --------------------
+
+ procedure Restore_Chains
+ (From : Entity_Id;
+ Upto : Entity_Id)
+ is
+ Shadow : Entity_Id;
+
+ begin
+ Shadow := From;
+ while Present (Shadow) and then Shadow /= Upto loop
- -- Lim_Typ is the limited view of a full type declaration
- -- that has a previous incomplete declaration, i.e. E3 from
- -- the previous description. Nothing to insert.
+ -- Do not unchain nested packages and child units
+ if Ekind (Shadow) = E_Package then
+ null;
+
+ elsif Is_Child_Unit (Non_Limited_View (Shadow)) then
null;
else
- pragma Assert (not In_Chain (E));
+ Restore_Chain_For_Shadow (Shadow);
+ end if;
- Prev := Current_Entity (Lim_Typ);
+ Next_Entity (Shadow);
+ end loop;
+ end Restore_Chains;
- if Prev = Lim_Typ then
- Set_Current_Entity (E);
+ -----------------------------
+ -- Restore_Type_Visibility --
+ -----------------------------
- else
- while Present (Prev)
- and then Homonym (Prev) /= Lim_Typ
- loop
- Prev := Homonym (Prev);
- end loop;
+ procedure Restore_Type_Visibility
+ (From : Entity_Id;
+ Upto : Entity_Id)
+ is
+ Typ : Entity_Id;
- if Present (Prev) then
- Set_Homonym (Prev, E);
- end if;
- end if;
+ begin
+ Typ := From;
+ while Present (Typ) and then Typ /= Upto loop
+ if Is_Type (Typ) then
+ Set_Is_Hidden (Typ, Was_Hidden (Typ));
+ end if;
- -- Preserve structure of homonym chain
+ Next_Entity (Typ);
+ end loop;
+ end Restore_Type_Visibility;
- Set_Homonym (E, Homonym (Lim_Typ));
- end if;
- end if;
+ -- Local variables
- Next_Entity (Lim_Typ);
- end loop;
+ Lim_Header : constant Entity_Id := Limited_View (Pack_Id);
+
+ -- Start of processing Remove_Shadow_Entities_With_Restore
+
+ begin
+ -- The limited view of a package is being uninstalled by removing
+ -- the effects of a limited with clause. If the clause appears in a
+ -- unit which is not part of the main unit closure, then the related
+ -- package must not be visible.
+
+ if Present (Lim_Clause)
+ and then not In_Extended_Main_Source_Unit (Lim_Clause)
+ then
+ Set_Is_Immediately_Visible (Pack_Id, False);
+
+ -- Otherwise a limited view is being overridden by a nonlimited view.
+ -- Leave the visibility of the package as is because the unit must be
+ -- visible when the nonlimited view is installed.
+
+ else
+ null;
+ end if;
+
+ -- Remove the shadow entities from visibility by updating the entity
+ -- and homonym chains.
+
+ Restore_Chains
+ (From => First_Entity (Lim_Header),
+ Upto => First_Private_Entity (Lim_Header));
+
+ -- Reinstate the types that were hidden by the shadow entities back
+ -- into direct visibility.
+
+ Restore_Type_Visibility
+ (From => First_Entity (Pack_Id),
+ Upto => First_Private_Entity (Pack_Id));
+ end Remove_Shadow_Entities_With_Restore;
+
+ -- Local variables
+
+ Pack_Id : constant Entity_Id := Defining_Entity (Pack_Decl);
+
+ -- Start of processing for Remove_Limited_With_Unit
+
+ begin
+ -- Nothing to do when the limited view of the package is not installed
+
+ if not From_Limited_With (Pack_Id) then
+ return;
+ end if;
+
+ if Debug_Flag_I then
+ Write_Str ("remove limited view of ");
+ Write_Name (Chars (Pack_Id));
+ Write_Str (" from visibility");
+ Write_Eol;
+ end if;
+
+ -- The package already appears in the compilation closure. As a result,
+ -- its shadow entities must be replaced by the real entities they hide
+ -- and the previously hidden entities must be entered back into direct
+ -- visibility.
+
+ -- WARNING: This code must be kept synchronized with that of routine
+ -- Install_Limited_Withed_Clause.
+
+ if Analyzed (Pack_Decl) then
+ Remove_Shadow_Entities_With_Restore (Pack_Id);
+
+ -- Otherwise the package is not analyzed and its shadow entities must be
+ -- removed from direct visibility.
+
+ else
+ Remove_Shadow_Entities_From_Visibility (Pack_Id);
end if;
-- Indicate that the limited view of the package is not installed
- Set_From_Limited_With (P, False);
- Set_Limited_View_Installed (N, False);
- end Remove_Limited_With_Clause;
+ Set_From_Limited_With (Pack_Id, False);
+ end Remove_Limited_With_Unit;
--------------------
-- Remove_Parents --