OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_attr.adb: Add with and use clauses for Sem_Ch10.

Browse Source 
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.

From-SVN: r148844
This commit is contained in:
Hristian Kirtchev 2009-06-23 10:15:47 +00:00 committed by Arnaud Charlet
parent 0d354370f2
commit c0985d4ed8
6 changed files with 145 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/ada/ChangeLog
View File

@ -1,3 +1,30 @@
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

28
gcc/ada/sem_attr.adb
View File

@ -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

129
gcc/ada/sem_ch10.adb
View File

@ -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 --
-----------------------

7
gcc/ada/sem_ch10.ads
View File

@ -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

18
gcc/ada/sem_ch3.adb
View File

@ -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;

17
gcc/ada/sem_res.adb
View File

@ -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