[Ada] fix visibility issues
Arnaud Charlet
charlet@adacore.com
Tue Aug 21 13:07:00 GMT 2007
Tested on i686-linux, committed on trunk
Each unit in the context of a compilation unit must be analyzed in a clean
compilation environment. Therefore, after each call to Analyze_Compilation_Unit
the just-compiled unit is removed from visibility. It is made suitably visible
when the whole context is installed later on. The removal was not taking place
when the unit was a subprogram body without a separate declaration, leading to
spurious visibility errors when a child unit with the same name appeared later
in the context.
The following must compile quietly:
with SMTP;
with Test_SMTP;
procedure Main is
begin
SMTP;
Test_SMTP;
end Main;
procedure SMTP is
begin
null;
end SMTP;
with AWS.SMTP;
procedure Test_SMTP is
use AWS;
V : SMTP.T := 111;
begin
V := V + 1;
end Test_SMTP;
package AWS is
end AWS;
package AWS.SMTP is
type T is new Integer;
end AWS.SMTP;
--
This patch also fixes an error in the visibility of limited views of units named
in limited_private_with clauses. All limited_with_clauses were installed in
one pass, after installing the non-limited context of the current unit. As a
result, entities in such units were visible prematurely, before the private
part of the current unit.
The command
$ gcc -c -gnatc p1.ads
must produce the error message:
p1.ads:4:42: "P2" is undefined
package P2 is
type T is tagged null record;
end P2;
limited private with P2;
package P1 is
procedure Init (N : in String; V : in P2.T);
end P1;
Finally, units mentioned in a private_with_clause are visible in the private
part of the current unit, and in the private part of nested packages. As a
result, units mentioned in private_with_clauses are made fully visible when
entering the private part of a nested package or instantiation, and removed
on exit. If a unit appears (explicitly or implicitly) both in a private_with
clause and a regular_with_clause, it should not be removed from visibility, so
tkhat its name is available in subsequent fully qualified names. This patch
checks whether a private_with_clause is made useless by the presence of a
regular with_clause in the context, and deletes it altogether from the context
clauses of the current unit, to speed up subsequent installations/removals of
private_with_clauses.
gnat.dg/private_with.ads must compile quietly.
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.
-------------- next part --------------
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 127358)
+++ sem_ch10.adb (working copy)
@@ -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;
More information about the Gcc-patches
mailing list