[Ada] clean up implementation of limited-with
Arnaud Charlet
charlet@adacore.com
Thu Jul 7 09:57:00 GMT 2005
Tested on i686-linux, committed on mainline.
This patch is a cleanup of the previous implementation of
limited-with clauses.
2005-07-07 Ed Schonberg <schonberg@adacore.com>
Javier Miranda <miranda@adacore.com>
* par-load.adb (Load): If a child unit is loaded through a limited_with
clause, each parent must be loaded as a limited unit as well.
* sem_ch10.adb (Previous_Withed_Unit): Better name for
Check_Withed_Unit. Return true if there is a previous with_clause for
this unit, whether limited or not.
(Expand_Limited_With_Clause): Do not generate a limited_with_clause on
the current unit.
(Is_Visible_Through_Renamings): New local subprogram of install_limited
_withed_unit that checks if some package installed through normal with
clauses has a renaming declaration of package whose limited-view is
ready to be installed. This enforces the check of the rule 10.1.2 (21/2)
of the current Draft document for Ada 2005.
(Analyze_Context): Complete the list of compilation units that
are allowed to contain limited-with clauses. It also contains
checks that were previously done by Install_Limited_Context_Clauses.
This makes the code more clear and easy to maintain.
(Expand_Limited_With_Clause) It is now a local subprogram of
Install_Limited_Context_Clauses, and contains the code that adds
the implicit limited-with clauses for parents of child units.
This functionality was prevously done by Analyze_Context.
* sem_ch4.adb (Analyze_Selected_Component): Check wrong use of
incomplete type.
* sem_ch7.adb (Analyze_Package_Declaration): Check if the package has
been erroneously named in a limited-with clause of its own context.
In this case the error has been previously notified by Analyze_Context.
-------------- next part --------------
Index: par-load.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-load.adb,v
retrieving revision 1.11
diff -u -p -r1.11 par-load.adb
--- par-load.adb 4 Jul 2005 13:28:59 -0000 1.11
+++ par-load.adb 7 Jul 2005 09:06:15 -0000
@@ -301,6 +301,8 @@ begin
end if;
-- If current unit is a child unit spec, load its parent
+ -- If the child unit is loaded through a limited with, the parent
+ -- must be as well.
elsif Nkind (Unit (Curunit)) = N_Package_Declaration
or else Nkind (Unit (Curunit)) = N_Subprogram_Declaration
@@ -323,7 +325,8 @@ begin
(Load_Name => Spec_Name,
Required => True,
Subunit => False,
- Error_Node => Curunit);
+ Error_Node => Curunit,
+ From_Limited_With => From_Limited_With);
if Unum /= No_Unit then
Set_Parent_Spec (Unit (Curunit), Cunit (Unum));
Index: sem_ch10.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch10.adb,v
retrieving revision 1.38
diff -u -p -r1.38 sem_ch10.adb
--- sem_ch10.adb 4 Jul 2005 13:29:19 -0000 1.38
+++ sem_ch10.adb 7 Jul 2005 09:06:16 -0000
@@ -95,14 +95,6 @@ package body Sem_Ch10 is
-- Verify that a stub is declared immediately within a compilation unit,
-- and not in an inner frame.
- procedure Expand_Limited_With_Clause (Nam : Node_Id; N : Node_Id);
- -- If a child unit appears in a limited_with clause, there are implicit
- -- limited_with clauses on all parents that are not already visible
- -- through a regular with clause. This procedure creates the implicit
- -- limited with_clauses for the parents and loads the corresponding units.
- -- The shadow entities are created when the inserted clause is analyzed.
- -- Implements Ada 2005 (AI-50217).
-
procedure Expand_With_Clause (Nam : Node_Id; N : Node_Id);
-- When a child unit appears in a context clause, the implicit withs on
-- parents are made explicit, and with clauses are inserted in the context
@@ -124,8 +116,8 @@ package body Sem_Ch10 is
-- all its ancestors.
procedure Install_Context_Clauses (N : Node_Id);
- -- Subsidiary to previous one. Process only with_ and use_clauses for
- -- current unit and its library unit if any.
+ -- Subsidiary to Install_Context and Install_Parents. Process only with_
+ -- and use_clauses for current unit and its library unit if any.
procedure Install_Limited_Context_Clauses (N : Node_Id);
-- Subsidiary to Install_Context. Process only limited with_clauses
@@ -138,7 +130,6 @@ package body Sem_Ch10 is
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,
@@ -807,11 +798,9 @@ package body Sem_Ch10 is
Item : Node_Id;
begin
- -- Loop through context items. This is done is three passes:
- -- a) The first pass analyze non-limited with-clauses.
- -- b) The second pass add implicit limited_with clauses for
- -- the parents of child units (Ada 2005: AI-50217)
- -- c) The third pass analyzes limited_with clauses (Ada 2005: AI-50217)
+ -- Loop through context items. This is done in two:
+ -- a) The first pass analyzes non-limited with-clauses
+ -- b) The second pass analyzes limited_with clauses (Ada 2005: AI-50217)
Item := First (Context_Items (N));
while Present (Item) loop
@@ -848,47 +837,133 @@ package body Sem_Ch10 is
Next (Item);
end loop;
- -- Second pass: add implicit limited_with_clauses for parents of
- -- child units mentioned in limited_with clauses.
+ -- Second pass: examine all limited_with clauses
Item := First (Context_Items (N));
-
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then Limited_Present (Item)
- and then Nkind (Name (Item)) = N_Selected_Component
then
- Expand_Limited_With_Clause
- (Nam => Prefix (Name (Item)), N => Item);
- end if;
+ -- No need to check errors on implicitly generated limited-with
+ -- clauses.
- Next (Item);
- end loop;
+ if not Implicit_With (Item) then
- -- Third pass: examine all limited_with clauses
+ -- Check compilation unit containing the limited-with clause
- Item := First (Context_Items (N));
+ if Ukind /= N_Package_Declaration
+ and then Ukind /= N_Subprogram_Declaration
+ and then Ukind /= N_Subprogram_Renaming_Declaration
+ and then Ukind /= N_Generic_Package_Declaration
+ and then Ukind /= N_Generic_Package_Renaming_Declaration
+ and then Ukind /= N_Generic_Subprogram_Declaration
+ and then Ukind /= N_Generic_Procedure_Renaming_Declaration
+ and then Ukind /= N_Package_Instantiation
+ and then Ukind /= N_Package_Renaming_Declaration
+ and then Ukind /= N_Procedure_Instantiation
+ then
+ Error_Msg_N ("limited with_clause not allowed here", Item);
- while Present (Item) loop
- if Nkind (Item) = N_With_Clause
- and then Limited_Present (Item)
- then
- -- Check the compilation unit containing the limited-with
- -- clause
+ -- Check wrong use of a limited with clause applied to the
+ -- compilation unit containing the limited-with clause.
- if Ukind /= N_Package_Declaration
- and then Ukind /= N_Subprogram_Declaration
- and then Ukind /= N_Subprogram_Renaming_Declaration
- and then Ukind /= N_Generic_Package_Declaration
- and then Ukind /= N_Generic_Package_Renaming_Declaration
- and then Ukind /= N_Generic_Subprogram_Declaration
- and then Ukind /= N_Generic_Procedure_Renaming_Declaration
- and then Ukind /= N_Package_Instantiation
- and then Ukind /= N_Package_Renaming_Declaration
- and then Ukind /= N_Procedure_Instantiation
- then
- Error_Msg_N
- ("limited with_clause not allowed here", Item);
+ -- limited with P.Q;
+ -- package P.Q is ...
+
+ elsif Unit (Library_Unit (Item)) = Unit (N) then
+ Error_Msg_N ("wrong use of limited-with clause", Item);
+
+ -- Check wrong use of limited-with clause applied to some
+ -- immediate ancestor.
+
+ elsif Is_Child_Spec (Unit (N)) then
+ declare
+ Lib_U : constant Entity_Id := Unit (Library_Unit (Item));
+ P : Node_Id;
+
+ begin
+ P := Parent_Spec (Unit (N));
+ loop
+ if Unit (P) = Lib_U then
+ Error_Msg_N ("limited with_clause of immediate "
+ & "ancestor not allowed", Item);
+ exit;
+ end if;
+
+ exit when not Is_Child_Spec (Unit (P));
+ P := Parent_Spec (Unit (P));
+ end loop;
+ end;
+ end if;
+
+ -- Check if the limited-withed unit is already visible through
+ -- some context clause of the current compilation unit or some
+ -- ancestor of the current compilation unit.
+
+ declare
+ Lim_Unit_Name : constant Node_Id := Name (Item);
+ Comp_Unit : Node_Id;
+ It : Node_Id;
+ Unit_Name : Node_Id;
+
+ begin
+ Comp_Unit := N;
+ loop
+ It := First (Context_Items (Comp_Unit));
+ while Present (It) loop
+ if Item /= It
+ and then Nkind (It) = N_With_Clause
+ and then not Limited_Present (It)
+ and then
+ (Nkind (Unit (Library_Unit (It)))
+ = N_Package_Declaration
+ or else
+ Nkind (Unit (Library_Unit (It)))
+ = N_Package_Renaming_Declaration)
+ then
+ if Nkind (Unit (Library_Unit (It)))
+ = N_Package_Declaration
+ then
+ Unit_Name := Name (It);
+ else
+ Unit_Name := Name (Unit (Library_Unit (It)));
+ end if;
+
+ -- Check if the named package (or some ancestor)
+ -- leaves visible the full-view of the unit given
+ -- in the limited-with clause
+
+ loop
+ if Designate_Same_Unit (Lim_Unit_Name,
+ Unit_Name)
+ then
+ Error_Msg_Sloc := Sloc (It);
+ Error_Msg_NE
+ ("unlimited view visible through the"
+ & " context clause found #",
+ Item, It);
+ Error_Msg_N
+ ("simultaneous visibility of the limited"
+ & " and unlimited views not allowed"
+ , Item);
+ exit;
+
+ elsif Nkind (Unit_Name) = N_Identifier then
+ exit;
+ end if;
+
+ Unit_Name := Prefix (Unit_Name);
+ end loop;
+ end if;
+
+ Next (It);
+ end loop;
+
+ exit when not Is_Child_Spec (Unit (Comp_Unit));
+
+ Comp_Unit := Parent_Spec (Unit (Comp_Unit));
+ end loop;
+ end;
end if;
-- Skip analyzing with clause if no unit, see above
@@ -2469,79 +2544,6 @@ package body Sem_Ch10 is
New_Nodes_OK := New_Nodes_OK - 1;
end Expand_With_Clause;
- --------------------------------
- -- Expand_Limited_With_Clause --
- --------------------------------
-
- procedure Expand_Limited_With_Clause (Nam : Node_Id; N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (Nam);
- Unum : Unit_Number_Type;
- Withn : Node_Id;
-
- begin
- New_Nodes_OK := New_Nodes_OK + 1;
-
- if Nkind (Nam) = N_Identifier then
- Withn :=
- Make_With_Clause (Loc, Name => Nam);
- Set_Limited_Present (Withn);
- Set_First_Name (Withn);
- Set_Implicit_With (Withn);
-
- -- Load the corresponding parent unit
-
- Unum :=
- Load_Unit
- (Load_Name => Get_Spec_Name (Get_Unit_Name (Nam)),
- Required => True,
- Subunit => False,
- Error_Node => Nam);
-
- if not Analyzed (Cunit (Unum)) then
- Set_Library_Unit (Withn, Cunit (Unum));
- Set_Corresponding_Spec
- (Withn, Specification (Unit (Cunit (Unum))));
-
- Prepend (Withn, Context_Items (Parent (N)));
- Mark_Rewrite_Insertion (Withn);
- end if;
-
- else pragma Assert (Nkind (Nam) = N_Selected_Component);
- Withn :=
- Make_With_Clause
- (Loc,
- Name =>
- Make_Selected_Component
- (Loc,
- Prefix => Prefix (Nam),
- Selector_Name => Selector_Name (Nam)));
-
- Set_Parent (Withn, Parent (N));
- Set_Limited_Present (Withn);
- Set_First_Name (Withn);
- Set_Implicit_With (Withn);
-
- Unum :=
- Load_Unit
- (Load_Name => Get_Spec_Name (Get_Unit_Name (Nam)),
- Required => True,
- Subunit => False,
- Error_Node => Nam);
-
- if not Analyzed (Cunit (Unum)) then
- Set_Library_Unit (Withn, Cunit (Unum));
- Set_Corresponding_Spec
- (Withn, Specification (Unit (Cunit (Unum))));
- Prepend (Withn, Context_Items (Parent (N)));
- Mark_Rewrite_Insertion (Withn);
-
- Expand_Limited_With_Clause (Prefix (Nam), N);
- end if;
- end if;
-
- New_Nodes_OK := New_Nodes_OK - 1;
- end Expand_Limited_With_Clause;
-
-----------------------
-- Get_Parent_Entity --
-----------------------
@@ -2938,10 +2940,9 @@ package body Sem_Ch10 is
procedure Install_Limited_Context_Clauses (N : Node_Id) is
Item : Node_Id;
- procedure Check_Parent (P : Node_Id; W : Node_Id);
+ procedure Check_Renamings (P : Node_Id; W : Node_Id);
-- Check that the unlimited view of a given compilation_unit is not
- -- already visible in the parents (neither immediately through the
- -- context clauses, nor indirectly through "use + renamings").
+ -- already visible through "use + renamings".
procedure Check_Private_Limited_Withed_Unit (N : Node_Id);
-- Check that if a limited_with clause of a given compilation_unit
@@ -2949,16 +2950,20 @@ package body Sem_Ch10 is
-- compilation_unit shall be the declaration of a private descendant
-- of that library unit.
- procedure Check_Withed_Unit (W : Node_Id);
- -- Check that a limited with_clause does not appear in the same
- -- context_clause as a nonlimited with_clause that mentions
- -- the same library.
+ procedure Expand_Limited_With_Clause
+ (Comp_Unit : Node_Id; Nam : Node_Id; N : Node_Id);
+ -- If a child unit appears in a limited_with clause, there are implicit
+ -- limited_with clauses on all parents that are not already visible
+ -- through a regular with clause. This procedure creates the implicit
+ -- limited with_clauses for the parents and loads the corresponding
+ -- units. The shadow entities are created when the inserted clause is
+ -- analyzed. Implements Ada 2005 (AI-50217).
- ------------------
- -- Check_Parent --
- ------------------
+ ---------------------
+ -- Check_Renamings --
+ ---------------------
- procedure Check_Parent (P : Node_Id; W : Node_Id) is
+ procedure Check_Renamings (P : Node_Id; W : Node_Id) is
Item : Node_Id;
Spec : Node_Id;
WEnt : Entity_Id;
@@ -2982,36 +2987,11 @@ package body Sem_Ch10 is
return;
end case;
- -- Step 1: Check if the unlimited view is installed in the parent
-
- Item := First (Context_Items (P));
- while Present (Item) loop
- if Nkind (Item) = N_With_Clause
- and then not Limited_Present (Item)
- and then not Implicit_With (Item)
- and then Library_Unit (Item) = Library_Unit (W)
- then
- Error_Msg_N ("unlimited view visible in ancestor", W);
- return;
- end if;
-
- Next (Item);
- end loop;
-
- -- Step 2: Check "use + renamings"
+ -- Check "use + renamings"
WEnt := Defining_Unit_Name (Specification (Unit (Library_Unit (W))));
Spec := Specification (Unit (P));
- -- We tried to traverse the list of entities corresponding to the
- -- defining entity of the package spec. However, first_entity was
- -- found to be 'empty'. Don't know why???
-
- -- Def := Defining_Unit_Name (Spec);
- -- Ent := First_Entity (Def);
-
- -- As a workaround we traverse the list of visible declarations ???
-
Item := First (Visible_Declarations (Spec));
while Present (Item) loop
@@ -3063,9 +3043,9 @@ package body Sem_Ch10 is
-- Recursive call to check all the ancestors
if Is_Child_Spec (Unit (P)) then
- Check_Parent (P => Parent_Spec (Unit (P)), W => W);
+ Check_Renamings (P => Parent_Spec (Unit (P)), W => W);
end if;
- end Check_Parent;
+ end Check_Renamings;
---------------------------------------
-- Check_Private_Limited_Withed_Unit --
@@ -3108,32 +3088,109 @@ package body Sem_Ch10 is
end if;
end Check_Private_Limited_Withed_Unit;
- -----------------------
- -- Check_Withed_Unit --
- -----------------------
+ --------------------------------
+ -- Expand_Limited_With_Clause --
+ --------------------------------
- procedure Check_Withed_Unit (W : Node_Id) is
- Item : Node_Id;
+ procedure Expand_Limited_With_Clause
+ (Comp_Unit : Node_Id;
+ Nam : Node_Id;
+ N : Node_Id)
+ is
+ Loc : constant Source_Ptr := Sloc (Nam);
+ Unum : Unit_Number_Type;
+ Withn : Node_Id;
+
+ 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
+ -- 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.
+
+ --------------------------
+ -- Previous_Withed_Unit --
+ --------------------------
+
+ function Previous_Withed_Unit (W : Node_Id) return Boolean is
+ Item : Node_Id;
+
+ begin
+ -- A limited with_clause can not appear in the same context_clause
+ -- as a nonlimited with_clause which mentions the same library.
+
+ Item := First (Context_Items (Comp_Unit));
+ while Present (Item) loop
+ if Nkind (Item) = N_With_Clause
+ and then Library_Unit (Item) = Library_Unit (W)
+ then
+ return True;
+ end if;
+
+ Next (Item);
+ end loop;
+
+ return False;
+ end Previous_Withed_Unit;
+
+ -- Start of processing for Expand_Limited_With_Clause
begin
- -- A limited with_clause can not appear in the same context_clause
- -- as a nonlimited with_clause which mentions the same library.
+ New_Nodes_OK := New_Nodes_OK + 1;
- Item := First (Context_Items (N));
- while Present (Item) loop
- if Nkind (Item) = N_With_Clause
- and then not Limited_Present (Item)
- and then not Implicit_With (Item)
- and then Library_Unit (Item) = Library_Unit (W)
- then
- Error_Msg_N ("limited and unlimited view "
- & "not allowed in the same context clauses", W);
+ if Nkind (Nam) = N_Identifier then
+ Withn := Make_With_Clause (Loc, Nam);
+
+ else pragma Assert (Nkind (Nam) = N_Selected_Component);
+ Withn := Make_With_Clause (Loc,
+ Make_Selected_Component (Loc,
+ Prefix => Prefix (Nam),
+ Selector_Name => Selector_Name (Nam)));
+ Set_Parent (Withn, Parent (N));
+ end if;
+
+ Set_Limited_Present (Withn);
+ Set_First_Name (Withn);
+ Set_Implicit_With (Withn);
+
+ Unum :=
+ Load_Unit
+ (Load_Name => Get_Spec_Name (Get_Unit_Name (Nam)),
+ Required => True,
+ Subunit => False,
+ Error_Node => Nam);
+
+ if not Analyzed (Cunit (Unum)) then
+ -- Do not generate a limited_with_clause on the current unit.
+ -- This path is taken when a unit has a limited_with clause on
+ -- one of its child units.
+
+ if Unum = Current_Sem_Unit then
return;
end if;
- Next (Item);
- end loop;
- end Check_Withed_Unit;
+ Set_Library_Unit (Withn, Cunit (Unum));
+ Set_Corresponding_Spec
+ (Withn, Specification (Unit (Cunit (Unum))));
+
+ if not Previous_Withed_Unit (Withn) then
+ Prepend (Withn, Context_Items (Parent (N)));
+ Mark_Rewrite_Insertion (Withn);
+
+ -- Add implicit limited_with_clauses for parents of child units
+ -- mentioned in limited_with clauses
+
+ if Nkind (Nam) = N_Selected_Component then
+ Expand_Limited_With_Clause (Comp_Unit, Prefix (Nam), N);
+ end if;
+
+ Analyze (Withn);
+ Install_Limited_Withed_Unit (Withn);
+ end if;
+ end if;
+
+ New_Nodes_OK := New_Nodes_OK - 1;
+ end Expand_Limited_With_Clause;
-- Start of processing for Install_Limited_Context_Clauses
@@ -3143,17 +3200,29 @@ package body Sem_Ch10 is
if Nkind (Item) = N_With_Clause
and then Limited_Present (Item)
then
- Check_Withed_Unit (Item);
+ if Nkind (Name (Item)) = N_Selected_Component then
+ Expand_Limited_With_Clause
+ (Comp_Unit => N, Nam => Prefix (Name (Item)), N => Item);
+ end if;
if Private_Present (Library_Unit (Item)) then
Check_Private_Limited_Withed_Unit (Item);
end if;
- if Is_Child_Spec (Unit (N)) then
- Check_Parent (Parent_Spec (Unit (N)), Item);
+ if not Implicit_With (Item)
+ and then Is_Child_Spec (Unit (N))
+ then
+ Check_Renamings (Parent_Spec (Unit (N)), Item);
end if;
- Install_Limited_Withed_Unit (Item);
+ -- 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 Library_Unit (Item) /= Cunit (Current_Sem_Unit) then
+ Install_Limited_Withed_Unit (Item);
+ end if;
end if;
Next (Item);
@@ -3406,6 +3475,10 @@ package body Sem_Ch10 is
-- Check that the shadow entity is not already in the homonym
-- chain, for example through a limited_with clause in a parent unit.
+ function Is_Visible_Through_Renamings (P : Entity_Id) return Boolean;
+ -- Check if some package installed though normal with-clauses has a
+ -- renaming declaration of package P. AARM 10.1.2(21/2).
+
--------------
-- In_Chain --
--------------
@@ -3425,6 +3498,94 @@ package body Sem_Ch10 is
return False;
end In_Chain;
+ ----------------------------------
+ -- Is_Visible_Through_Renamings --
+ ----------------------------------
+
+ function Is_Visible_Through_Renamings (P : Entity_Id) return Boolean is
+ Kind : constant Node_Kind := Nkind (Unit (Cunit (Current_Sem_Unit)));
+ Aux_Unit : Node_Id;
+ Item : Node_Id;
+ Decl : Entity_Id;
+
+ begin
+ -- Example of the error detected by this subprogram:
+
+ -- package P is
+ -- type T is ...
+ -- end P;
+
+ -- with P;
+ -- package Q is
+ -- package Ren_P renames P;
+ -- end Q;
+
+ -- with Q;
+ -- package R is ...
+
+ -- limited with P; -- ERROR
+ -- package R.C is ...
+
+ Aux_Unit := Cunit (Current_Sem_Unit);
+ loop
+ Item := First (Context_Items (Aux_Unit));
+ while Present (Item) loop
+ if Nkind (Item) = N_With_Clause
+ and then not Limited_Present (Item)
+ and then Nkind (Unit (Library_Unit (Item)))
+ = N_Package_Declaration
+ then
+ Decl :=
+ First (Visible_Declarations
+ (Specification (Unit (Library_Unit (Item)))));
+ while Present (Decl) loop
+ if Nkind (Decl) = N_Package_Renaming_Declaration
+ and then Entity (Name (Decl)) = P
+ then
+ -- Generate the error message only if the current unit
+ -- is a package declaration; in case of subprogram
+ -- bodies and package bodies we just return true to
+ -- indicate that the limited view must not be
+ -- installed.
+
+ if Kind = N_Package_Declaration then
+ Error_Msg_Sloc := Sloc (Item);
+ Error_Msg_NE
+ ("unlimited view of & visible through the context"
+ & " clause found #", N, P);
+
+ Error_Msg_Sloc := Sloc (Decl);
+ Error_Msg_NE
+ ("unlimited view of & visible through the"
+ & " renaming found #", N, P);
+
+ Error_Msg_N
+ ("simultaneous visibility of the limited and"
+ & " unlimited views not allowed", N);
+ end if;
+
+ return True;
+ end if;
+
+ Next (Decl);
+ end loop;
+ end if;
+
+ Next (Item);
+ end loop;
+
+ if Present (Library_Unit (Aux_Unit)) then
+ Aux_Unit := Library_Unit (Aux_Unit);
+ else
+ Aux_Unit := Parent_Spec (Unit (Aux_Unit));
+ end if;
+
+ exit when not Present (Aux_Unit);
+ end loop;
+
+ return False;
+ end Is_Visible_Through_Renamings;
+
-- Start of processing for Install_Limited_Withed_Unit
begin
@@ -3446,7 +3607,14 @@ package body Sem_Ch10 is
P := Defining_Identifier (P);
end if;
- -- A common usage of the limited-with is to have a limited-with
+ -- Do not install the limited-view if the full-view is already visible
+ -- through some renaming declaration
+
+ if Is_Visible_Through_Renamings (P) then
+ return;
+ end if;
+
+ -- A common use of the limited-with is to have a limited-with
-- in the package spec, and a normal with in its package body.
-- For example:
@@ -3542,7 +3710,6 @@ package body Sem_Ch10 is
Set_Scope (P, Parent_Id);
end;
end if;
-
else
-- If the unit appears in a previous regular with_clause, the
@@ -3559,10 +3726,9 @@ package body Sem_Ch10 is
Next_Entity (Ent);
end loop;
end;
-
end if;
- -- The package must be visible while the with_type clause is active,
+ -- The package must be visible while the limited-with clause is active,
-- because references to the type P.T must resolve in the usual way.
Set_Is_Immediately_Visible (P);
Index: sem_ch4.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch4.adb,v
retrieving revision 1.42
diff -u -p -r1.42 sem_ch4.adb
--- sem_ch4.adb 4 Jul 2005 13:29:36 -0000 1.42
+++ sem_ch4.adb 7 Jul 2005 09:06:16 -0000
@@ -2679,6 +2679,25 @@ package body Sem_Ch4 is
Resolve (Name);
+ -- Ada 2005 (AI-50217): Check wrong use of incomplete type.
+ -- Example:
+
+ -- limited with Pkg;
+ -- package Pkg is
+ -- type Acc_Inc is access Pkg.T;
+ -- X : Acc_Inc;
+ -- N : Natural := X.all.Comp; -- ERROR
+ -- end Pkg;
+
+ if Nkind (Name) = N_Explicit_Dereference
+ and then From_With_Type (Etype (Prefix (Name)))
+ and then not Is_Potentially_Use_Visible (Etype (Name))
+ then
+ Error_Msg_NE
+ ("premature usage of incomplete}", Prefix (Name),
+ Etype (Prefix (Name)));
+ end if;
+
-- We never need an actual subtype for the case of a selection
-- for a indexed component of a non-packed array, since in
-- this case gigi generates all the checks and can find the
Index: sem_ch7.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch7.adb,v
retrieving revision 1.24
diff -u -p -r1.24 sem_ch7.adb
--- sem_ch7.adb 1 Jul 2005 01:28:05 -0000 1.24
+++ sem_ch7.adb 7 Jul 2005 09:06:16 -0000
@@ -623,6 +623,17 @@ package body Sem_Ch7 is
PF : Boolean;
begin
+ -- Ada 2005 (AI-217): Check if the package has been erroneously named
+ -- in a limited-with clause of its own context. In this case the error
+ -- has been previously notified by Analyze_Context.
+
+ -- limited with Pkg; -- ERROR
+ -- package Pkg is ...
+
+ if From_With_Type (Id) then
+ return;
+ end if;
+
Generate_Definition (Id);
Enter_Name (Id);
Set_Ekind (Id, E_Package);
More information about the Gcc-patches
mailing list