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

[multiple changes] 

2011-09-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_disp.adb (Find_Controlling_Arg): Add checks for
	interface type conversions, that are expanded into dereferences.

2011-09-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper):
	Examine the parameter and return profile of a subprogram and swap
	any incomplete types coming from a limited context with their
	corresponding non-limited views.
	(Exchange_Limited_Views): New routine.

2011-09-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Prepare_Private_Subtype_Completion): Set parent
	of internal entity to the subtype declaration, so that when
	entities are subsequently exchanged in a package body, the tree
	remains properly formatted for ASIS.

From-SVN: r178548
This commit is contained in:
Arnaud Charlet 2011-09-05 16:12:04 +02:00
parent 8da1a31296
commit 5dcab3ca08
4 changed files with 123 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
2011-09-05 Ed Schonberg <schonberg@adacore.com>
* sem_disp.adb (Find_Controlling_Arg): Add checks for
interface type conversions, that are expanded into dereferences.
2011-09-05 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper):
Examine the parameter and return profile of a subprogram and swap
any incomplete types coming from a limited context with their
corresponding non-limited views.
(Exchange_Limited_Views): New routine.
2011-09-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Prepare_Private_Subtype_Completion): Set parent
of internal entity to the subtype declaration, so that when
entities are subsequently exchanged in a package body, the tree
remains properly formatted for ASIS.
2011-09-05 Johannes Kanig <kanig@adacore.com>
* g-comlin.adb (Set_Usage): Additional optional argument to set help

5
gcc/ada/sem_ch3.adb
View File

@ -17052,13 +17052,16 @@ package body Sem_Ch3 is
-- The Base_Type is already completed, we can complete the subtype
-- now. We have to create a new entity with the same name, Thus we
-- can't use Create_Itype.
-- can't use Create_Itype. The entity may be exchanged when entering
-- exiting a package body, so it has to have a proper parent field,
-- so that the tree is always properly formatted for ASIS.
-- This is messy, should be fixed ???
Full := Make_Defining_Identifier (Sloc (Id), Chars (Id));
Set_Is_Itype (Full);
Set_Associated_Node_For_Itype (Full, Related_Nod);
Set_Parent (Full, Parent (Id));
Complete_Private_Subtype (Id, Full, Full_B, Related_Nod);
end if;

73
gcc/ada/sem_ch6.adb
View File

@ -1727,6 +1727,11 @@ package body Sem_Ch6 is
-- mechanism is used to find the corresponding spec of the primitive
-- body.
procedure Exchange_Limited_Views (Subp_Id : Entity_Id);
-- Ada 2012 (AI05-0151): Detect whether the profile of Subp_Id contains
-- incomplete types coming from a limited context and swap their limited
-- views with the non-limited ones.
function Is_Private_Concurrent_Primitive
(Subp_Id : Entity_Id) return Boolean;
-- Determine whether subprogram Subp_Id is a primitive of a concurrent
@ -2092,6 +2097,65 @@ package body Sem_Ch6 is
return Spec_N;
end Disambiguate_Spec;
----------------------------
-- Exchange_Limited_Views --
----------------------------
procedure Exchange_Limited_Views (Subp_Id : Entity_Id) is
procedure Detect_And_Exchange (Id : Entity_Id);
-- Determine whether Id's type denotes an incomplete type associated
-- with a limited with clause and exchange the limited view with the
-- non-limited one.
-------------------------
-- Detect_And_Exchange --
-------------------------
procedure Detect_And_Exchange (Id : Entity_Id) is
Typ : constant Entity_Id := Etype (Id);
begin
if Ekind (Typ) = E_Incomplete_Type
and then From_With_Type (Typ)
and then Present (Non_Limited_View (Typ))
then
Set_Etype (Id, Non_Limited_View (Typ));
end if;
end Detect_And_Exchange;
-- Local variables
Formal : Entity_Id;
-- Start of processing for Exchange_Limited_Views
begin
if No (Subp_Id) then
return;
-- Do not process subprogram bodies as they already use the non-
-- limited view of types.
elsif not Ekind_In (Subp_Id, E_Function, E_Procedure) then
return;
end if;
-- Examine all formals and swap views when applicable
Formal := First_Formal (Subp_Id);
while Present (Formal) loop
Detect_And_Exchange (Formal);
Next_Formal (Formal);
end loop;
-- Process the return type of a function
if Ekind (Subp_Id) = E_Function then
Detect_And_Exchange (Subp_Id);
end if;
end Exchange_Limited_Views;
-------------------------------------
-- Is_Private_Concurrent_Primitive --
-------------------------------------
@ -2726,6 +2790,15 @@ package body Sem_Ch6 is
(Sloc (N), Spec_Id, Prot_Typ, N, Declarations (N));
end if;
-- Ada 2012 (AI05-0151): Incomplete types coming from a limited context
-- may now appear in parameter and result profiles. Since the analysis
-- of a subprogram body may use the parameter and result profile of the
-- spec, swap any limited views with their non-limited counterpart.
if Ada_Version >= Ada_2012 then
Exchange_Limited_Views (Spec_Id);
end if;
-- Analyze the declarations (this call will analyze the precondition
-- Check pragmas we prepended to the list, as well as the declaration
-- of the _Postconditions procedure).

26
gcc/ada/sem_disp.adb
View File

@ -1616,6 +1616,32 @@ package body Sem_Disp is
then
return Controlling_Argument (Orig_Node);
-- Type conversions are dynamically tagged if the target type, or its
-- designated type, are classwide. An interface conversion expands into
-- a dereference, so test must be performed on the original node.
elsif Nkind (Orig_Node) = N_Type_Conversion
and then Nkind (N) = N_Explicit_Dereference
and then Is_Controlling_Actual (N)
then
declare
Target_Type : constant Entity_Id :=
Entity (Subtype_Mark (Orig_Node));
begin
if Is_Class_Wide_Type (Target_Type) then
return N;
elsif Is_Access_Type (Target_Type)
and then Is_Class_Wide_Type (Designated_Type (Target_Type))
then
return N;
else
return Empty;
end if;
end;
-- Normal case
elsif Is_Controlling_Actual (N)