This patch fixes a visibility error when compiling a unit DDP, when an
ancestor P of DDP has a private limited with clause on a descendant of P that
is itself an ancestor of DDP.
The following must compile quietly:
gcc -c -gnat05 bg-el-lc.adb
---
package body BG.El.LC is
overriding procedure Bind (E : access One_Port; K : in AKind) is
begin
null;
end Bind;
end BG.El.LC;
---
package BG.El.LC is
type Component is abstract new Element with null record;
private
type One_Port is new Component with null record;
overriding procedure Bind (E : access One_Port; K : in AKind);
end BG.El.LC;
---
with Ada.Strings.Bounded;
private
package BG.El is
type Element is abstract tagged private;
type AKind is (A, B);
procedure Bind (E : access Element; K : in AKind) is abstract;
private
type Element is abstract tagged null record;
end BG.El;
---
limited private with BG.El;
package BG is
type Object is abstract tagged limited private;
procedure Bind (Graph : in out Object) is abstract;
private
type Object is abstract tagged limited null record;
end BG;
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-10-04 Ed Schonberg <schonb...@adacore.com>
* sem_ch10.adb (Is_Ancestor_Unit): Make global, for use elsewhere.
(Install_Private_with_Clauses): if clause is private and limited,
do not install the limited view if the library unit is an ancestor
of the unit being compiled. This unusual configuration occurs
when compiling a unit DDP, when an ancestor P of DDP has a
private limited with clause on a descendant of P that is itself
an ancestor of DDP.
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 192066)
+++ sem_ch10.adb (working copy)
@@ -164,6 +164,11 @@
-- an enclosing scope. Iterate over context to find child units of U_Name
-- or of some ancestor of it.
+ function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean;
+ -- When compiling a unit Q descended from some parent unit P, a limited
+ -- with_clause in the context of P that names some other ancestor of Q
+ -- must not be installed because the ancestor is immediately visible.
+
function Is_Child_Spec (Lib_Unit : Node_Id) return Boolean;
-- Lib_Unit is a library unit which may be a spec or a body. Is_Child_Spec
-- returns True if Lib_Unit is a library spec which is a child spec, i.e.
@@ -3521,11 +3526,6 @@
-- units. The shadow entities are created when the inserted clause is
-- analyzed. Implements Ada 2005 (AI-50217).
- function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean;
- -- When compiling a unit Q descended from some parent unit P, a limited
- -- with_clause in the context of P that names some other ancestor of Q
- -- must not be installed because the ancestor is immediately visible.
-
---------------------
-- Check_Renamings --
---------------------
@@ -3794,22 +3794,6 @@
end if;
end Expand_Limited_With_Clause;
- ----------------------
- -- Is_Ancestor_Unit --
- ----------------------
-
- function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean is
- E1 : constant Entity_Id := Defining_Entity (Unit (U1));
- E2 : Entity_Id;
- begin
- if Nkind_In (Unit (U2), N_Package_Body, N_Subprogram_Body) then
- E2 := Defining_Entity (Unit (Library_Unit (U2)));
- return Is_Ancestor_Package (E1, E2);
- else
- return False;
- end if;
- end Is_Ancestor_Unit;
-
-- Start of processing for Install_Limited_Context_Clauses
begin
@@ -4061,8 +4045,17 @@
if Nkind (Item) = N_With_Clause
and then Private_Present (Item)
then
+ -- If the unit is an ancestor of the current one, it is the
+ -- case of a private limited with clause on a child unit, and
+ -- the compilation of one of its descendants, In that case the
+ -- limited view is errelevant.
+
if Limited_Present (Item) then
- if not Limited_View_Installed (Item) then
+ if not Limited_View_Installed (Item)
+ and then
+ not Is_Ancestor_Unit (Library_Unit (Item),
+ Cunit (Current_Sem_Unit))
+ then
Install_Limited_Withed_Unit (Item);
end if;
else
@@ -5269,6 +5262,22 @@
(C_Unit, Cunit_Entity (Get_Source_Unit (Non_Limited_View (T))));
end Is_Legal_Shadow_Entity_In_Body;
+ ----------------------
+ -- Is_Ancestor_Unit --
+ ----------------------
+
+ function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean is
+ E1 : constant Entity_Id := Defining_Entity (Unit (U1));
+ E2 : Entity_Id;
+ begin
+ if Nkind_In (Unit (U2), N_Package_Body, N_Subprogram_Body) then
+ E2 := Defining_Entity (Unit (Library_Unit (U2)));
+ return Is_Ancestor_Package (E1, E2);
+ else
+ return False;
+ end if;
+ end Is_Ancestor_Unit;
+
-----------------------
-- Load_Needed_Body --
-----------------------
