Skip to content

R
riscv-gcc-1
Commit 50b8a7b8 by Ed Schonberg Committed by Arnaud Charlet
Options

sem_ch10.adb: Create a limited view of an incomplete type... 

2007-08-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb: Create a limited view of an incomplete type, to make
	treatment of limited views uniform for all visible declarations in a
	limited_withed package.
	Set flag indicating that a subprogram body for a child unit has a
	generated spec.
	(Analyze_Compilation_Unit): If unit is a subprogram body that has no
	separate declaration, remove the unit name from visibility after
	compilation, so that environment is clean for subsequent compilations.
	(Install_Limited_Context_Clauses): Do not install a
	limited_private_with_clause unless the current unit is a body or a
	private child unit.
	(Analyze_Subunit, Install_Parents): Treat generic and non-generic units
	in the same fashion.
	(Install_Limited_Withed_Unit): Do not install a limited with clause if
	it applies to the declaration of the current package body.
	(Remove_Private_With_Clauses): If there is a regular with_clause for
	the unit, delete Private_With_Clause from context, to prevent improper
	hiding when processing subsequent nested packages and instantiations.

From-SVN: r127436
parent febb581c
Showing with 248 additions and 170 deletions
gcc/ada/sem_ch10.adb
......@@ -230,7 +230,7 @@ package body Sem_Ch10 is
procedure Analyze_Compilation_Unit (N : Node_Id) is
Unit_Node : constant Node_Id := Unit (N);
Lib_Unit : Node_Id := Library_Unit (N);
Spec_Id : Node_Id;
Spec_Id : Entity_Id;
Main_Cunit : constant Node_Id := Cunit (Main_Unit);
Par_Spec_Name : Unit_Name_Type;
Unum : Unit_Number_Type;
......@@ -590,7 +590,7 @@ package body Sem_Ch10 is
P_Name : Entity_Id := P_Id;
begin
Pref := Name (Parent (Defining_Entity (N)));
Pref := Name (Parent (Defining_Entity (N)));
if Nkind (Pref) = N_Expanded_Name then
......@@ -707,10 +707,10 @@ package body Sem_Ch10 is
-- If the subprogram body is a child unit, we must create a
-- declaration for it, in order to properly load the parent(s).
-- After this, the original unit does not acts as a spec, because
-- there is an explicit one. If this unit appears in a context
-- there is an explicit one. If this unit appears in a context
-- clause, then an implicit with on the parent will be added when
-- installing the context. If this is the main unit, there is no
-- Unit_Table entry for the declaration, (It has the unit number
-- Unit_Table entry for the declaration (it has the unit number
-- of the main unit) and code generation is unaffected.
Unum := Get_Cunit_Unit_Number (N);
......@@ -729,7 +729,10 @@ package body Sem_Ch10 is
-- Build subprogram declaration and attach parent unit to it
-- This subprogram declaration does not come from source,
-- Nevertheless the backend must generate debugging info for
-- it, and this must be indicated explicitly.
-- it, and this must be indicated explicitly. We also mark
-- the body entity as a child unit now, to prevent a
-- cascaded error if the spec entity cannot be entered
-- in its scope.
declare
Loc : constant Source_Ptr := Sloc (N);
......@@ -752,7 +755,12 @@ package body Sem_Ch10 is
Set_Library_Unit (N, Lib_Unit);
Set_Parent_Spec (Unit (Lib_Unit), Cunit (Unum));
Semantics (Lib_Unit);
-- Now that a separate declaration exists, the body
-- of the child unit does not act as spec any longer.
Set_Acts_As_Spec (N, False);
Set_Is_Child_Unit (Defining_Entity (Unit_Node));
Set_Needs_Debug_Info (Defining_Entity (Unit (Lib_Unit)));
Set_Comes_From_Source_Default (SCS);
end;
......@@ -801,9 +809,9 @@ package body Sem_Ch10 is
end if;
-- With the analysis done, install the context. Note that we can't
-- install the context from the with clauses as we analyze them,
-- because each with clause must be analyzed in a clean visibility
-- context, so we have to wait and install them all at once.
-- install the context from the with clauses as we analyze them, because
-- each with clause must be analyzed in a clean visibility context, so
-- we have to wait and install them all at once.
Install_Context (N);
......@@ -838,8 +846,8 @@ package body Sem_Ch10 is
end if;
end if;
-- The above call might have made Unit_Node an N_Subprogram_Body
-- from something else, so propagate any Acts_As_Spec flag.
-- The above call might have made Unit_Node an N_Subprogram_Body from
-- something else, so propagate any Acts_As_Spec flag.
if Nkind (Unit_Node) = N_Subprogram_Body
and then Acts_As_Spec (Unit_Node)
......@@ -907,16 +915,23 @@ package body Sem_Ch10 is
end if;
-- Remove unit from visibility, so that environment is clean for
-- the next compilation, which is either the main unit or some
-- other unit in the context.
if Nkind (Unit_Node) = N_Package_Declaration
or else Nkind (Unit_Node) in N_Generic_Declaration
or else Nkind (Unit_Node) = N_Package_Renaming_Declaration
or else Nkind (Unit_Node) = N_Subprogram_Declaration
or else
(Nkind (Unit_Node) = N_Subprogram_Body
and then Acts_As_Spec (Unit_Node))
then
Remove_Unit_From_Visibility (Defining_Entity (Unit_Node));
-- If the unit is an instantiation whose body will be elaborated
-- for inlining purposes, use the the proper entity of the instance.
-- The entity may be missing if the instantiation was illegal.
-- If the unit is an instantiation whose body will be elaborated for
-- inlining purposes, use the the proper entity of the instance. The
-- entity may be missing if the instantiation was illegal.
elsif Nkind (Unit_Node) = N_Package_Instantiation
and then not Error_Posted (Unit_Node)
......@@ -929,41 +944,41 @@ package body Sem_Ch10 is
or else (Nkind (Unit_Node) = N_Subprogram_Body
and then not Acts_As_Spec (Unit_Node))
then
-- Bodies that are not the main unit are compiled if they
-- are generic or contain generic or inlined units. Their
-- analysis brings in the context of the corresponding spec
-- (unit declaration) which must be removed as well, to
-- return the compilation environment to its proper state.
-- Bodies that are not the main unit are compiled if they are generic
-- or contain generic or inlined units. Their analysis brings in the
-- context of the corresponding spec (unit declaration) which must be
-- removed as well, to return the compilation environment to its
-- proper state.
Remove_Context (Lib_Unit);
Set_Is_Immediately_Visible (Defining_Entity (Unit (Lib_Unit)), False);
end if;
-- Last step is to deinstall the context we just installed
-- as well as the unit just compiled.
-- Last step is to deinstall the context we just installed as well as
-- the unit just compiled.
Remove_Context (N);
-- If this is the main unit and we are generating code, we must
-- check that all generic units in the context have a body if they
-- need it, even if they have not been instantiated. In the absence
-- of .ali files for generic units, we must force the load of the body,
-- just to produce the proper error if the body is absent. We skip this
-- If this is the main unit and we are generating code, we must check
-- that all generic units in the context have a body if they need it,
-- even if they have not been instantiated. In the absence of .ali files
-- for generic units, we must force the load of the body, just to
-- produce the proper error if the body is absent. We skip this
-- verification if the main unit itself is generic.
if Get_Cunit_Unit_Number (N) = Main_Unit
and then Operating_Mode = Generate_Code
and then Expander_Active
then
-- Check whether the source for the body of the unit must be
-- included in a standalone library.
-- Check whether the source for the body of the unit must be included
-- in a standalone library.
Check_Body_Needed_For_SAL (Cunit_Entity (Main_Unit));
-- Indicate that the main unit is now analyzed, to catch possible
-- circularities between it and generic bodies. Remove main unit
-- from visibility. This might seem superfluous, but the main unit
-- must not be visible in the generic body expansions that follow.
-- circularities between it and generic bodies. Remove main unit from
-- visibility. This might seem superfluous, but the main unit must
-- not be visible in the generic body expansions that follow.
Set_Analyzed (N, True);
Set_Is_Immediately_Visible (Cunit_Entity (Main_Unit), False);
......@@ -1050,23 +1065,23 @@ package body Sem_Ch10 is
if Comes_From_Source (N)
and then
(Nkind (Unit (N)) = N_Package_Declaration or else
Nkind (Unit (N)) = N_Generic_Package_Declaration or else
Nkind (Unit (N)) = N_Subprogram_Declaration or else
Nkind (Unit (N)) = N_Generic_Subprogram_Declaration)
(Nkind (Unit_Node) = N_Package_Declaration or else
Nkind (Unit_Node) = N_Generic_Package_Declaration or else
Nkind (Unit_Node) = N_Subprogram_Declaration or else
Nkind (Unit_Node) = N_Generic_Subprogram_Declaration)
then
declare
Loc : constant Source_Ptr := Sloc (N);
Unum : constant Unit_Number_Type := Get_Source_Unit (Loc);
begin
Spec_Id := Defining_Entity (Unit (N));
Spec_Id := Defining_Entity (Unit_Node);
Generate_Definition (Spec_Id);
-- See if an elaboration entity is required for possible
-- access before elaboration checking. Note that we must
-- allow for this even if -gnatE is not set, since a client
-- may be compiled in -gnatE mode and reference the entity.
-- See if an elaboration entity is required for possible access
-- before elaboration checking. Note that we must allow for this
-- even if -gnatE is not set, since a client may be compiled in
-- -gnatE mode and reference the entity.
-- These entities are also used by the binder to prevent multiple
-- attempts to execute the elaboration code for the library case
......@@ -1168,7 +1183,7 @@ package body Sem_Ch10 is
-- Push current compilation unit as scope, so that the test for
-- being within an obsolescent unit will work correctly.
Push_Scope (Defining_Entity (Unit (N)));
Push_Scope (Defining_Entity (Unit_Node));
-- Loop through context items to deal with with clauses
......@@ -1375,14 +1390,14 @@ package body Sem_Ch10 is
Unit_Name)
then
Error_Msg_Sloc := Sloc (It);
Error_Msg_N
("simultaneous visibility of limited "
& "and unlimited views not allowed",
Item);
Error_Msg_NE
("unlimited view visible through the"
& " context clause found #",
("\unlimited view visible through "
& "context clause #",
Item, It);
Error_Msg_N
("\simultaneous visibility of the limited"
& " and unlimited views not allowed"
, Item);
exit;
elsif Nkind (Unit_Name) = N_Identifier then
......@@ -1979,7 +1994,9 @@ package body Sem_Ch10 is
-- all the parents are bodies. Restore full visibility of their
-- private entities.
if Ekind (Scop) = E_Package then
if Ekind (Scop) = E_Package
or else Ekind (Scop) = E_Generic_Package
then
Set_In_Package_Body (Scop);
Install_Private_Declarations (Scop);
end if;
......@@ -2069,7 +2086,9 @@ package body Sem_Ch10 is
-- context includes another subunit of the same parent which in
-- turn includes a child unit in its context.
if Ekind (Par_Unit) = E_Package then
if Ekind (Par_Unit) = E_Package
or else Ekind (Par_Unit) = E_Generic_Package
then
if not Is_Immediately_Visible (Par_Unit)
or else (Present (First_Entity (Par_Unit))
and then not Is_Immediately_Visible
......@@ -2236,15 +2255,15 @@ package body Sem_Ch10 is
U := Unit (Library_Unit (N));
Intunit := Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit));
-- Following checks are skipped for dummy packages (those supplied
-- for with's where no matching file could be found). Such packages
-- are identified by the Sloc value being set to No_Location
-- Following checks are skipped for dummy packages (those supplied for
-- with's where no matching file could be found). Such packages are
-- identified by the Sloc value being set to No_Location
if Sloc (U) /= No_Location then
-- Check restrictions, except that we skip the check if this
-- is an internal unit unless we are compiling the internal
-- unit as the main unit. We also skip this for dummy packages.
-- Check restrictions, except that we skip the check if this is an
-- internal unit unless we are compiling the internal unit as the
-- main unit. We also skip this for dummy packages.
Check_Restriction_No_Dependence (Nam, N);
......@@ -2266,10 +2285,10 @@ package body Sem_Ch10 is
Special_Exception_Package_Used := True;
end if;
-- Check for inappropriate with of internal implementation unit
-- if we are currently compiling the main unit and the main unit
-- is itself not an internal unit. We do not issue this message
-- for implicit with's generated by the compiler itself.
-- Check for inappropriate with of internal implementation unit if we
-- are currently compiling the main unit and the main unit is itself
-- not an internal unit. We do not issue this message for implicit
-- with's generated by the compiler itself.
if Implementation_Unit_Warnings
and then Current_Sem_Unit = Main_Unit
......@@ -2306,11 +2325,11 @@ package body Sem_Ch10 is
if Unit_Kind in N_Generic_Declaration then
E_Name := Defining_Entity (U);
-- Note: in the following test, Unit_Kind is the original Nkind, but
-- in the case of an instantiation, semantic analysis above will
-- have replaced the unit by its instantiated version. If the instance
-- body has been generated, the instance now denotes the body entity.
-- For visibility purposes we need the entity of its spec.
-- Note: in the following test, Unit_Kind is the original Nkind, but in
-- the case of an instantiation, semantic analysis above will have
-- replaced the unit by its instantiated version. If the instance body
-- has been generated, the instance now denotes the body entity. For
-- visibility purposes we need the entity of its spec.
elsif (Unit_Kind = N_Package_Instantiation
or else Nkind (Original_Node (Unit (Library_Unit (N)))) =
......@@ -2330,9 +2349,9 @@ package body Sem_Ch10 is
elsif Unit_Kind in N_Subprogram_Instantiation then
-- Instantiation node is replaced with a wrapper package.
-- Retrieve the visible subprogram created by the instance from
-- the corresponding attribute of the wrapper.
-- Instantiation node is replaced with a wrapper package. Retrieve
-- the visible subprogram created by the instance from corresponding
-- attribute of the wrapper.
E_Name := Related_Instance (Defining_Entity (U));
......@@ -2469,8 +2488,8 @@ package body Sem_Ch10 is
elsif Nkind (Lib_Unit) = N_Subunit then
-- The parent is itself a body. The parent entity is to be found
-- in the corresponding spec.
-- The parent is itself a body. The parent entity is to be found in
-- the corresponding spec.
Sub_Parent := Library_Unit (N);
Curr_Unit := Defining_Entity (Unit (Library_Unit (Sub_Parent)));
......@@ -2519,9 +2538,9 @@ package body Sem_Ch10 is
Curr_Private : Boolean := Is_Private_Library_Unit (Curr_Unit);
begin
-- If the child unit is a public child then locate
-- the nearest private ancestor; Child_Parent will
-- then be set to the parent of that ancestor.
-- If the child unit is a public child then locate the nearest
-- private ancestor. Child_Parent will then be set to the
-- parent of that ancestor.
if not Is_Private_Library_Unit (Priv_Child) then
while Present (Prv_Ancestor)
......@@ -2710,9 +2729,7 @@ package body Sem_Ch10 is
is
Loc : constant Source_Ptr := Sloc (N);
P : constant Node_Id := Parent_Spec (Child_Unit);
P_Unit : Node_Id := Unit (P);
P_Unit : Node_Id := Unit (P);
P_Name : constant Entity_Id := Get_Parent_Entity (P_Unit);
Withn : Node_Id;
......@@ -2720,8 +2737,7 @@ package body Sem_Ch10 is
-- Build prefix of child unit name. Recurse if needed
function Build_Unit_Name return Node_Id;
-- If the unit is a child unit, build qualified name with all
-- ancestors.
-- If the unit is a child unit, build qualified name with all ancestors
-------------------------
-- Build_Ancestor_Name --
......@@ -2775,9 +2791,9 @@ package body Sem_Ch10 is
-- Start of processing for Implicit_With_On_Parent
begin
-- The unit of the current compilation may be a package body
-- that replaces an instance node. In this case we need the
-- original instance node to construct the proper parent name.
-- The unit of the current compilation may be a package body that
-- replaces an instance node. In this case we need the original instance
-- node to construct the proper parent name.
if Nkind (P_Unit) = N_Package_Body
and then Nkind (Original_Node (P_Unit)) = N_Package_Instantiation
......@@ -2785,9 +2801,9 @@ package body Sem_Ch10 is
P_Unit := Original_Node (P_Unit);
end if;
-- We add the implicit with if the child unit is the current unit
-- being compiled. If the current unit is a body, we do not want
-- to add an implicit_with a second time to the corresponding spec.
-- We add the implicit with if the child unit is the current unit being
-- compiled. If the current unit is a body, we do not want to add an
-- implicit_with a second time to the corresponding spec.
if Nkind (Child_Unit) = N_Package_Declaration
and then Child_Unit /= Unit (Cunit (Current_Sem_Unit))
......@@ -2918,8 +2934,8 @@ package body Sem_Ch10 is
Decl_Node := Unit_Declaration_Node (Uname_Node);
-- If the unit is a subprogram instance, it appears nested
-- within a package that carries the parent information.
-- If the unit is a subprogram instance, it appears nested within
-- a package that carries the parent information.
if Is_Generic_Instance (Uname_Node)
and then Ekind (Uname_Node) /= E_Package
......@@ -3213,8 +3229,8 @@ package body Sem_Ch10 is
("unlimited view visible through use clause ", W);
return;
end if;
end if;
Next (Nam);
end loop;
end if;
......@@ -3264,7 +3280,6 @@ package body Sem_Ch10 is
-- unit to check if it is a descendant of named library unit.
Curr_Parent := Parent (Item);
while Present (Parent_Spec (Unit (Curr_Parent)))
and then Curr_Parent /= Child_Parent
loop
......@@ -3422,15 +3437,27 @@ package body Sem_Ch10 is
Check_Renamings (Parent_Spec (Unit (N)), Item);
end if;
-- A unit may have a limited with on itself if it has a
-- limited with_clause on one of its child units. In that
-- case it is already being compiled and it makes no sense
-- to install its limited view.
-- A unit may have a limited with on itself if it has a limited
-- with_clause on one of its child units. In that case it is
-- already being compiled and it makes no sense to install its
-- limited view.
-- If the item is a limited_private_with_clause, install it if the
-- current unit is a body or if it is a private child. Otherwise
-- the private clause is installed before analyzing the private
-- part of the current unit.
if Library_Unit (Item) /= Cunit (Current_Sem_Unit)
and then not Limited_View_Installed (Item)
then
Install_Limited_Withed_Unit (Item);
if not Private_Present (Item)
or else Private_Present (N)
or else Nkind (Unit (N)) = N_Package_Body
or else Nkind (Unit (N)) = N_Subprogram_Body
or else Nkind (Unit (N)) = N_Subunit
then
Install_Limited_Withed_Unit (Item);
end if;
end if;
-- All items other than Limited_With clauses are ignored (they were
......@@ -3475,7 +3502,8 @@ package body Sem_Ch10 is
-- 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 non-limited 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.
......@@ -3536,12 +3564,12 @@ package body Sem_Ch10 is
Error_Msg_N ("parent unit cannot be a renaming", Lib_Unit);
raise Unrecoverable_Error;
-- Verify that a child of an instance is itself an instance, or
-- the renaming of one. Given that an instance that is a unit is
-- replaced with a package declaration, check against the original
-- node. The parent may be currently being instantiated, in which
-- case it appears as a declaration, but the generic_parent is
-- already established indicating that we deal with an instance.
-- Verify that a child of an instance is itself an instance, or the
-- renaming of one. Given that an instance that is a unit is replaced
-- with a package declaration, check against the original node. The
-- parent may be currently being instantiated, in which case it appears
-- as a declaration, but the generic_parent is already established
-- indicating that we deal with an instance.
elsif Nkind (Original_Node (P)) = N_Package_Instantiation then
......@@ -3572,13 +3600,13 @@ package body Sem_Ch10 is
Install_Limited_Context_Clauses (Parent_Spec (Lib_Unit));
Install_Siblings (P_Name, Parent (Lib_Unit));
-- The child unit is in the declarative region of the parent. The
-- parent must therefore appear in the scope stack and be visible,
-- as when compiling the corresponding body. If the child unit is
-- private or it is a package body, private declarations must be
-- accessible as well. Use declarations in the parent must also
-- be installed. Finally, other child units of the same parent that
-- are in the context are immediately visible.
-- The child unit is in the declarative region of the parent. The parent
-- must therefore appear in the scope stack and be visible, as when
-- compiling the corresponding body. If the child unit is private or it
-- is a package body, private declarations must be accessible as well.
-- Use declarations in the parent must also be installed. Finally, other
-- child units of the same parent that are in the context are
-- immediately visible.
-- Find entity for compilation unit, and set its private descendant
-- status as needed.
......@@ -3602,8 +3630,8 @@ package body Sem_Ch10 is
Install_Visible_Declarations (P_Name);
Set_Use (Visible_Declarations (P_Spec));
-- If the parent is a generic unit, its formal part may contain
-- formal packages and use clauses for them.
-- If the parent is a generic unit, its formal part may contain formal
-- packages and use clauses for them.
if Ekind (P_Name) = E_Generic_Package then
Set_Use (Generic_Formal_Declarations (Parent (P_Spec)));
......@@ -3662,9 +3690,9 @@ package body Sem_Ch10 is
Id : Entity_Id;
Prev : Entity_Id;
begin
-- Iterate over explicit with clauses, and check whether the
-- scope of each entity is an ancestor of the current unit, in
-- which case it is immediately visible.
-- Iterate over explicit with clauses, and check whether the scope of
-- each entity is an ancestor of the current unit, in which case it is
-- immediately visible.
Item := First (Context_Items (N));
while Present (Item) loop
......@@ -3717,11 +3745,11 @@ package body Sem_Ch10 is
end;
end if;
-- The With_Clause may be on a grand-child or one of its
-- further descendants, which makes a child immediately visible.
-- Examine ancestry to determine whether such a child exists.
-- For example, if current unit is A.C, and with_clause is on
-- A.X.Y.Z, then X is immediately visible.
-- The With_Clause may be on a grand-child or one of its further
-- descendants, which makes a child immediately visible. Examine
-- ancestry to determine whether such a child exists. For example,
-- if current unit is A.C, and with_clause is on A.X.Y.Z, then X
-- is immediately visible.
elsif Is_Child_Unit (Id) then
declare
......@@ -3816,14 +3844,14 @@ package body Sem_Ch10 is
if Kind = N_Package_Declaration then
Error_Msg_N
("simultaneous visibility of the limited and" &
" unlimited views not allowed", N);
("simultaneous visibility of the limited and " &
"unlimited views not allowed", N);
Error_Msg_Sloc := Sloc (Item);
Error_Msg_NE
("\unlimited view of & visible through the" &
" context clause found #", N, P);
("\\ unlimited view of & visible through the " &
"context clause #", N, P);
Error_Msg_Sloc := Sloc (Decl);
Error_Msg_NE ("\and the renaming found #", N, P);
Error_Msg_NE ("\\ and the renaming #", N, P);
end if;
return True;
......@@ -3890,9 +3918,14 @@ package body Sem_Ch10 is
-- This unusual case will happen when a unit has a limited_with clause
-- on one of its children. The compilation of the child forces the
-- load of the parent which tries to install the limited view of the
-- child again.
-- child again. Installing the limited view must also be disabled
-- when compiling the body of the child unit.
if P = Cunit_Entity (Current_Sem_Unit) then
if P = Cunit_Entity (Current_Sem_Unit)
or else
(Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body
and then P = Main_Unit_Entity)
then
return;
end if;
......@@ -4013,7 +4046,7 @@ package body Sem_Ch10 is
-- by the shadow ones.
-- This code must be kept synchronized with the code that replaces the
-- the shadow entities by the real entities (see body of Remove_Limited
-- shadow entities by the real entities (see body of Remove_Limited
-- With_Clause); otherwise the contents of the homonym chains are not
-- consistent.
......@@ -4035,7 +4068,8 @@ package body Sem_Ch10 is
-- Replace the real entities by the shadow entities of the limited
-- view. The first element of the limited view is a header that is
-- used to reference the first shadow entity in the private part
-- of the package.
-- of the package. Successive elements are the limited views of the
-- type (including regular incomplete types) declared in the package.
Lim_Header := Limited_View (P);
......@@ -4055,18 +4089,10 @@ package body Sem_Ch10 is
begin
Prev := Current_Entity (Lim_Typ);
E := Prev;
-- Handle incomplete types
if Ekind (Prev) = E_Incomplete_Type
and then Present (Full_View (Prev))
then
E := Full_View (Prev);
else
E := Prev;
end if;
-- Replace E in the homonyms list
-- Replace E in the homonyms list, so that the limited
-- view becomes available.
if E = Non_Limited_View (Lim_Typ) then
Set_Homonym (Lim_Typ, Homonym (Prev));
......@@ -4075,21 +4101,21 @@ package body Sem_Ch10 is
else
loop
E := Homonym (Prev);
pragma Assert (Present (E));
-- Handle incomplete types
-- E may have been removed when installing a
-- previous limited_with_clause.
if Ekind (E) = E_Incomplete_Type then
E := Full_View (E);
end if;
exit when No (E);
exit when E = Non_Limited_View (Lim_Typ);
Prev := Homonym (Prev);
end loop;
Set_Homonym (Lim_Typ, Homonym (Homonym (Prev)));
Set_Homonym (Prev, Lim_Typ);
if Present (E) then
Set_Homonym (Lim_Typ, Homonym (Homonym (Prev)));
Set_Homonym (Prev, Lim_Typ);
end if;
end if;
end;
......@@ -4282,7 +4308,7 @@ package body Sem_Ch10 is
begin
U2 := Homonym (Uname);
while Present (U2)
and U2 /= Standard_Standard
and then U2 /= Standard_Standard
loop
P2 := Scope (U2);
Decl2 := Unit_Declaration_Node (P2);
......@@ -4297,7 +4323,7 @@ package body Sem_Ch10 is
Error_Msg_N ("illegal with_clause", With_Clause);
Error_Msg_N
("\child unit has visible homograph" &
" ('R'M 8.3(26), 10.1.1(19))",
" (RM 8.3(26), 10.1.1(19))",
With_Clause);
exit;
......@@ -4322,7 +4348,7 @@ package body Sem_Ch10 is
Error_Msg_N ("illegal with_clause", Prev_Clause);
Error_Msg_N
("\child unit has visible homograph" &
" ('R'M 8.3(26), 10.1.1(19))",
" (RM 8.3(26), 10.1.1(19))",
Prev_Clause);
exit;
end;
......@@ -4357,15 +4383,14 @@ package body Sem_Ch10 is
-- Load_Needed_Body --
-----------------------
-- N is a generic unit named in a with clause, or else it is
-- a unit that contains a generic unit or an inlined function.
-- In order to perform an instantiation, the body of the unit
-- must be present. If the unit itself is generic, we assume
-- that an instantiation follows, and load and analyze the body
-- unconditionally. This forces analysis of the spec as well.
-- N is a generic unit named in a with clause, or else it is a unit that
-- contains a generic unit or an inlined function. In order to perform an
-- instantiation, the body of the unit must be present. If the unit itself
-- is generic, we assume that an instantiation follows, and load & analyze
-- the body unconditionally. This forces analysis of the spec as well.
-- If the unit is not generic, but contains a generic unit, it
-- is loaded on demand, at the point of instantiation (see ch12).
-- If the unit is not generic, but contains a generic unit, it is loaded on
-- demand, at the point of instantiation (see ch12).
procedure Load_Needed_Body (N : Node_Id; OK : out Boolean) is
Body_Name : Unit_Name_Type;
......@@ -4569,16 +4594,17 @@ package body Sem_Ch10 is
-- For each library_package_declaration in the environment, there
-- is an implicit declaration of a *limited view* of that library
-- package. The limited view of a package contains:
--
-- * For each nested package_declaration, a declaration of the
-- limited view of that package, with the same defining-
-- program-unit name.
--
-- * For each type_declaration in the visible part, an incomplete
-- type-declaration with the same defining_identifier, whose
-- completion is the type_declaration. If the type_declaration
-- is tagged, then the incomplete_type_declaration is tagged
-- incomplete.
-- The partial view is tagged if the declaration has the
-- explicit keyword, or else if it is a type extension, both
-- of which can be ascertained syntactically.
......@@ -4622,7 +4648,9 @@ package body Sem_Ch10 is
Set_Non_Limited_View (Lim_Typ, Comp_Typ);
elsif Nkind (Decl) = N_Private_Type_Declaration then
elsif Nkind (Decl) = N_Private_Type_Declaration
or else Nkind (Decl) = N_Incomplete_Type_Declaration
then
Comp_Typ := Defining_Identifier (Decl);
if not Analyzed_Unit then
......@@ -4716,8 +4744,8 @@ package body Sem_Ch10 is
begin
pragma Assert (Limited_Present (N));
-- A library_item mentioned in a limited_with_clause shall be
-- a package_declaration, not a subprogram_declaration,
-- A library_item mentioned in a limited_with_clause shall
-- be a package_declaration, not a subprogram_declaration,
-- generic_declaration, generic_instantiation, or
-- package_renaming_declaration
......@@ -4779,8 +4807,8 @@ package body Sem_Ch10 is
Set_Is_Internal (Lim_Header);
Set_Limited_View (P, Lim_Header);
-- Create the auxiliary chain. All the shadow entities are appended
-- to the list of entities of the limited-view header
-- Create the auxiliary chain. All the shadow entities are appended to
-- the list of entities of the limited-view header
Build_Chain
(Scope => P,
......@@ -4815,9 +4843,9 @@ package body Sem_Ch10 is
procedure Check_Body_Needed_For_SAL (Unit_Name : Entity_Id) is
function Entity_Needs_Body (E : Entity_Id) return Boolean;
-- Determine whether use of entity E might require the presence
-- of its body. For a package this requires a recursive traversal
-- of all nested declarations.
-- Determine whether use of entity E might require the presence of its
-- body. For a package this requires a recursive traversal of all nested
-- declarations.
---------------------------
-- Entity_Needed_For_SAL --
......@@ -4960,8 +4988,8 @@ package body Sem_Ch10 is
Item := First (Context_Items (N));
while Present (Item) loop
-- We are interested only in with clauses which got installed
-- on entry, as indicated by their Context_Installed flag set
-- We are interested only in with clauses which got installed on
-- entry, as indicated by their Context_Installed flag set
if Nkind (Item) = N_With_Clause
and then Limited_Present (Item)
......@@ -5107,9 +5135,10 @@ package body Sem_Ch10 is
loop
Prev := Homonym (Prev);
end loop;
pragma Assert (Present (Prev));
Set_Homonym (Prev, E);
if Present (Prev) then
Set_Homonym (Prev, E);
end if;
end if;
-- We must also set the next homonym entity of the real entity
......@@ -5188,23 +5217,72 @@ package body Sem_Ch10 is
procedure Remove_Private_With_Clauses (Comp_Unit : Node_Id) is
Item : Node_Id;
function In_Regular_With_Clause (E : Entity_Id) return Boolean;
-- Check whether a given unit appears in a regular with_clause.
-- Used to determine whether a private_with_clause, implicit or
-- explicit, should be ignored.
----------------------------
-- In_Regular_With_Clause --
----------------------------
function In_Regular_With_Clause (E : Entity_Id) return Boolean
is
Item : Node_Id;
begin
Item := First (Context_Items (Comp_Unit));
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then Entity (Name (Item)) = E
and then not Private_Present (Item)
then
return True;
end if;
Next (Item);
end loop;
return False;
end In_Regular_With_Clause;
-- Start of processing for Remove_Private_With_Clauses
begin
Item := First (Context_Items (Comp_Unit));
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then Private_Present (Item)
then
if Limited_Present (Item) then
-- If private_with_clause is redundant, remove it from
-- context, as a small optimization to subsequent handling
-- of private_with clauses in other nested packages..
if In_Regular_With_Clause (Entity (Name (Item))) then
declare
Nxt : constant Node_Id := Next (Item);
begin
Remove (Item);
Item := Nxt;
end;
elsif Limited_Present (Item) then
if not Limited_View_Installed (Item) then
Remove_Limited_With_Clause (Item);
end if;
Next (Item);
else
Remove_Unit_From_Visibility (Entity (Name (Item)));
Set_Context_Installed (Item, False);
Next (Item);
end if;
end if;
Next (Item);
else
Next (Item);
end if;
end loop;
end Remove_Private_With_Clauses;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment