* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148844
138bc75d-0d04-0410-961f-
82ee72b054a4
+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.
+
2009-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Remove_Limited_With_Clause): Clean up code that handles
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;
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
-- 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.
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 --
-----------------------------
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);
-- 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).
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 --
----------------------------------
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.
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 --
-----------------------
-- --
-- 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- --
-- 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
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
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));
-- 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));
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;
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;
--------------------------
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
OSDN Git Service
