[Ada] Name resolution for limited views
Arnaud Charlet
charlet@adacore.com
Tue Jun 23 11:37:00 GMT 2009
This patch corrects the handling of limited views associated with subprogram
formals of anonymous access type.
package P is
type Some_Type ...
end P;
limited with P;
package Main is
procedure Do_Something (Param : access P.Some_Type);
end Main;
with P;
package Main is
procedure Do_Something (Param : access P.Some_Type) is ...
end Main;
If the body of Do_Something references Param in any way, its uses were flagged
as "illegal use of incomplete type" even though this is legal code. When the
limited context of P is uninstalled at the end of Main's spec, the anonymous
access type of Param still references the shadow entity for Some_Type. Later,
when the body of Do_Something is processed and the non-limited view of Some_
Type is available, the compiler would still use the type of Param coming from
the spec of Do_Something. Since this is a general mechanism in the compiler,
the patch adds code to recognize such legal uses of limited views associated
with anonymous access types and prevent false positives.
Tested on x86_64-pc-linux-gnu, committed on trunk
2009-06-23 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb: Add with and use clauses for Sem_Ch10.
(Check_Not_Incomplete_Type): Minor reformatting. Retrieve the root type
when dealing with class-wide types. Detect a legal shadow entity and
retrieve its non-limited view.
* sem_ch10.adb (Has_With_Clause): Move the spec and body of the
subprogram to top package level from Intall_Limited_Withed_Unit.
(Install_Limited_Withed_Unit): Remove spec and body of Has_With_Clause.
Add check which prevents the installation of a limited view if the
non-limited view is already visible through a with clause.
(Is_Legal_Shadow_Entity_In_Body): New routine. Detect a residual, but
legal shadow entity which may occur in subprogram formals of anonymous
access type.
* sem_ch10.ads (Is_Legal_Shadow_Entity_In_Body): New routine.
* sem_ch3.adb (Access_Definition): Remove the propagation of flag
From_With_Type from the designated type to the generated anonymous
access type. Remove associated comment.
* sem_res.adb Add with and use clauses for Sem_Ch10.
(Full_Designated_Type): Detect a legal shadow entity and retrieve its
non-limited view. Since the shadow entity may replace a regular
incomplete type, return the available full view.
-------------- next part --------------
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 148834)
+++ sem_ch3.adb (working copy)
@@ -840,8 +840,8 @@ package body Sem_Ch3 is
Desig_Type := Entity (Subtype_Mark (N));
Set_Directly_Designated_Type
- (Anon_Type, Desig_Type);
- Set_Etype (Anon_Type, Anon_Type);
+ (Anon_Type, Desig_Type);
+ Set_Etype (Anon_Type, Anon_Type);
-- Make sure the anonymous access type has size and alignment fields
-- set, as required by gigi. This is necessary in the case of the
@@ -873,11 +873,6 @@ package body Sem_Ch3 is
Set_Is_Public (Anon_Type, Is_Public (Scope (Anon_Type)));
- -- Ada 2005 (AI-50217): Propagate the attribute that indicates that the
- -- designated type comes from the limited view.
-
- Set_From_With_Type (Anon_Type, From_With_Type (Desig_Type));
-
-- Ada 2005 (AI-231): Propagate the access-constant attribute
Set_Is_Access_Constant (Anon_Type, Constant_Present (N));
@@ -960,7 +955,7 @@ package body Sem_Ch3 is
-- introduce semantic dependencies.
elsif Nkind (Related_Nod) = N_Function_Specification
- and then not From_With_Type (Anon_Type)
+ and then not From_With_Type (Desig_Type)
then
if Present (Enclosing_Prot_Type) then
Build_Itype_Reference (Anon_Type, Parent (Enclosing_Prot_Type));
@@ -12046,11 +12041,10 @@ package body Sem_Ch3 is
elsif Chars (Parent_Subp) = Name_Op_Eq
and then Is_Dispatching_Operation (Parent_Subp)
and then Etype (Parent_Subp) = Standard_Boolean
+ and then not Is_Limited_Type (Etype (First_Formal (Parent_Subp)))
and then
- not Is_Limited_Type (Etype (First_Formal (Parent_Subp)))
- and then
- Etype (First_Formal (Parent_Subp))
- = Etype (Next_Formal (First_Formal (Parent_Subp)))
+ Etype (First_Formal (Parent_Subp)) =
+ Etype (Next_Formal (First_Formal (Parent_Subp)))
then
Set_Derived_Name;
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 148843)
+++ sem_ch10.adb (working copy)
@@ -108,6 +108,13 @@ package body Sem_Ch10 is
-- has not yet been rewritten as a package declaration, and the entity has
-- to be retrieved from the Instance_Spec of the unit.
+ function Has_With_Clause
+ (C_Unit : Node_Id;
+ Pack : Entity_Id;
+ Is_Limited : Boolean := False) return Boolean;
+ -- Determine whether compilation unit C_Unit contains a with clause for
+ -- package Pack. Use flag Is_Limited to designate desired clause kind.
+
procedure Implicit_With_On_Parent (Child_Unit : Node_Id; N : Node_Id);
-- If the main unit is a child unit, implicit withs are also added for
-- all its ancestors.
@@ -2802,6 +2809,49 @@ package body Sem_Ch10 is
end if;
end Get_Parent_Entity;
+ ---------------------
+ -- Has_With_Clause --
+ ---------------------
+
+ function Has_With_Clause
+ (C_Unit : Node_Id;
+ Pack : Entity_Id;
+ Is_Limited : Boolean := False) return Boolean
+ is
+ Item : Node_Id;
+ Nam : Entity_Id;
+
+ begin
+ if Present (Context_Items (C_Unit)) then
+ Item := First (Context_Items (C_Unit));
+ while Present (Item) loop
+ if Nkind (Item) = N_With_Clause then
+
+ -- Retrieve the entity of the imported compilation unit
+
+ if Nkind (Name (Item)) = N_Selected_Component then
+ Nam := Entity (Selector_Name (Name (Item)));
+ else
+ Nam := Entity (Name (Item));
+ end if;
+
+ if Nam = Pack
+ and then
+ ((Is_Limited and then Limited_Present (Item))
+ or else
+ (not Is_Limited and then not Limited_Present (Item)))
+ then
+ return True;
+ end if;
+ end if;
+
+ Next (Item);
+ end loop;
+ end if;
+
+ return False;
+ end Has_With_Clause;
+
-----------------------------
-- Implicit_With_On_Parent --
-----------------------------
@@ -3558,12 +3608,6 @@ package body Sem_Ch10 is
Install_Limited_Withed_Unit (Item);
end if;
end if;
-
- -- All items other than Limited_With clauses are ignored (they were
- -- installed separately early on by Install_Context_Clause).
-
- else
- null;
end if;
Next (Item);
@@ -3913,14 +3957,6 @@ package body Sem_Ch10 is
-- Determine whether any package in the ancestor chain starting with
-- C_Unit has a limited with clause for package Pack.
- function Has_With_Clause
- (C_Unit : Node_Id;
- Pack : Entity_Id;
- Is_Limited : Boolean := False) return Boolean;
- -- Determine whether compilation unit C_Unit contains a with clause
- -- for package Pack. Use flag Is_Limited to designate desired clause
- -- kind. This is a subsidiary routine to Has_Limited_With_Clause.
-
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).
@@ -4253,49 +4289,6 @@ package body Sem_Ch10 is
return False;
end Has_Limited_With_Clause;
- ---------------------
- -- Has_With_Clause --
- ---------------------
-
- function Has_With_Clause
- (C_Unit : Node_Id;
- Pack : Entity_Id;
- Is_Limited : Boolean := False) return Boolean
- is
- Item : Node_Id;
- Nam : Entity_Id;
-
- begin
- if Present (Context_Items (C_Unit)) then
- Item := First (Context_Items (C_Unit));
- while Present (Item) loop
- if Nkind (Item) = N_With_Clause then
-
- -- Retrieve the entity of the imported compilation unit
-
- if Nkind (Name (Item)) = N_Selected_Component then
- Nam := Entity (Selector_Name (Name (Item)));
- else
- Nam := Entity (Name (Item));
- end if;
-
- if Nam = Pack
- and then
- ((Is_Limited and then Limited_Present (Item))
- or else
- (not Is_Limited and then not Limited_Present (Item)))
- then
- return True;
- end if;
- end if;
-
- Next (Item);
- end loop;
- end if;
-
- return False;
- end Has_With_Clause;
-
----------------------------------
-- Is_Visible_Through_Renamings --
----------------------------------
@@ -4423,6 +4416,15 @@ package body Sem_Ch10 is
P := Defining_Identifier (P);
end if;
+ -- Do not install the limited-view if the context of the unit is already
+ -- available through a regular with clause.
+
+ if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body
+ and then Has_With_Clause (Cunit (Current_Sem_Unit), P)
+ then
+ return;
+ end if;
+
-- Do not install the limited-view if the full-view is already visible
-- through renaming declarations.
@@ -4907,6 +4909,19 @@ package body Sem_Ch10 is
and then Present (Parent_Spec (Lib_Unit));
end Is_Child_Spec;
+ ------------------------------------
+ -- Is_Legal_Shadow_Entity_In_Body --
+ ------------------------------------
+
+ function Is_Legal_Shadow_Entity_In_Body (T : Entity_Id) return Boolean is
+ C_Unit : constant Node_Id := Cunit (Current_Sem_Unit);
+
+ begin
+ return Nkind (Unit (C_Unit)) = N_Package_Body
+ and then Has_With_Clause (C_Unit,
+ Cunit_Entity (Get_Source_Unit (Non_Limited_View (T))));
+ end Is_Legal_Shadow_Entity_In_Body;
+
-----------------------
-- Load_Needed_Body --
-----------------------
Index: sem_ch10.ads
===================================================================
--- sem_ch10.ads (revision 148742)
+++ sem_ch10.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -43,6 +43,11 @@ package Sem_Ch10 is
-- its private part, compiling a private child unit, or compiling the
-- private declarations of a public child unit.
+ function Is_Legal_Shadow_Entity_In_Body (T : Entity_Id) return Boolean;
+ -- Assuming that type T is an incomplete type coming from a limited with
+ -- view, determine whether the package where T resides is imported through
+ -- a regular with clause in the current package body.
+
procedure Remove_Context (N : Node_Id);
-- Removes the entities from the context clause of the given compilation
-- unit from the visibility chains. This is done on exit from a unit as
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 148794)
+++ sem_res.adb (working copy)
@@ -57,6 +57,7 @@ with Sem_Cat; use Sem_Cat;
with Sem_Ch4; use Sem_Ch4;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
+with Sem_Ch10; use Sem_Ch10;
with Sem_Ch13; use Sem_Ch13;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
@@ -9619,16 +9620,20 @@ package body Sem_Res is
--------------------------
function Full_Designated_Type (T : Entity_Id) return Entity_Id is
- Desig : constant Entity_Id := Designated_Type (T);
+ Desig : Entity_Id := Designated_Type (T);
+
begin
- if From_With_Type (Desig)
- and then Is_Incomplete_Type (Desig)
+ -- Detect a legal use of a shadow entity
+
+ if Is_Incomplete_Type (Desig)
+ and then From_With_Type (Desig)
and then Present (Non_Limited_View (Desig))
+ and then Is_Legal_Shadow_Entity_In_Body (Desig)
then
- return Non_Limited_View (Desig);
- else
- return Desig;
+ Desig := Non_Limited_View (Desig);
end if;
+
+ return Available_View (Desig);
end Full_Designated_Type;
-- Local Declarations
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 148742)
+++ sem_attr.adb (working copy)
@@ -51,6 +51,7 @@ with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
+with Sem_Ch10; use Sem_Ch10;
with Sem_Dist; use Sem_Dist;
with Sem_Elim; use Sem_Elim;
with Sem_Eval; use Sem_Eval;
@@ -1345,15 +1346,32 @@ package body Sem_Attr is
E := Prefix (E);
end loop;
- if From_With_Type (Etype (E)) then
+ Typ := Etype (E);
+
+ if From_With_Type (Typ) then
Error_Attr_P
("prefix of % attribute cannot be an incomplete type");
else
- if Is_Access_Type (Etype (E)) then
- Typ := Directly_Designated_Type (Etype (E));
- else
- Typ := Etype (E);
+ if Is_Access_Type (Typ) then
+ Typ := Directly_Designated_Type (Typ);
+ end if;
+
+ if Is_Class_Wide_Type (Typ) then
+ Typ := Root_Type (Typ);
+ end if;
+
+ -- A legal use of a shadow entity occurs only when the unit
+ -- where the non-limited view resides is imported via a regular
+ -- with clause in the current body. Such references to shadow
+ -- entities may occur in subprogram formals.
+
+ if Is_Incomplete_Type (Typ)
+ and then From_With_Type (Typ)
+ and then Present (Non_Limited_View (Typ))
+ and then Is_Legal_Shadow_Entity_In_Body (Typ)
+ then
+ Typ := Non_Limited_View (Typ);
end if;
if Ekind (Typ) = E_Incomplete_Type
More information about the Gcc-patches
mailing list