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

[multiple changes]

Browse Source 
2009-04-15  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb: Minor reformatting.

	* sem_type.adb: Minor reformatting

2009-04-15  Javier Miranda  <miranda@adacore.com>

	* sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Add missing
	support to check eliminated subprograms.

	* sem_elim.ads (Eliminate_Error_Msg): Update documentation.

	* sem_elim.adb (Set_Eliminated): Add support for elimination of
	dispatching subprograms.

	* exp_disp.adb (Make_DT): Minor code cleanup when freezing primitive
	operations. Initialize with "null" the slots of eliminated dispaching
	primitives.
	(Write_DT): Add output for eliminated primitives.

	* sem_disp.adb (Check_Dispatching_Call): Check eliminated primitives.

From-SVN: r146093
This commit is contained in:
Arnaud Charlet 2009-04-15 11:37:59 +02:00
parent 5afaa917da
commit 361effb15b
8 changed files with 71 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
2009-04-15 Robert Dewar <dewar@adacore.com>
* sem_prag.adb: Minor reformatting.
* sem_type.adb: Minor reformatting
2009-04-15 Javier Miranda <miranda@adacore.com>
* sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Add missing
support to check eliminated subprograms.
* sem_elim.ads (Eliminate_Error_Msg): Update documentation.
* sem_elim.adb (Set_Eliminated): Add support for elimination of
dispatching subprograms.
* exp_disp.adb (Make_DT): Minor code cleanup when freezing primitive
operations. Initialize with "null" the slots of eliminated dispaching
primitives.
(Write_DT): Add output for eliminated primitives.
* sem_disp.adb (Check_Dispatching_Call): Check eliminated primitives.
2009-04-15 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Use_One_Type): If both clauses appear on the same unit,

18
gcc/ada/exp_disp.adb
View File

@ -3941,27 +3941,29 @@ package body Exp_Disp is
then
declare
Save : constant Boolean := Freezing_Library_Level_Tagged_Type;
Prim : Entity_Id;
Prim_Elmt : Elmt_Id;
Frnodes : List_Id;
begin
Freezing_Library_Level_Tagged_Type := True;
Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
while Present (Prim_Elmt) loop
Frnodes := Freeze_Entity (Node (Prim_Elmt), Loc);
Prim := Node (Prim_Elmt);
Frnodes := Freeze_Entity (Prim, Loc);
declare
Subp : constant Entity_Id := Node (Prim_Elmt);
F : Entity_Id;
begin
F := First_Formal (Subp);
F := First_Formal (Prim);
while Present (F) loop
Check_Premature_Freezing (Subp, Etype (F));
Check_Premature_Freezing (Prim, Etype (F));
Next_Formal (F);
end loop;
Check_Premature_Freezing (Subp, Etype (Subp));
Check_Premature_Freezing (Prim, Etype (Prim));
end;
if Present (Frnodes) then
@ -3970,6 +3972,7 @@ package body Exp_Disp is
Next_Elmt (Prim_Elmt);
end loop;
Freezing_Library_Level_Tagged_Type := Save;
end;
end if;
@ -5145,6 +5148,7 @@ package body Exp_Disp is
if Is_Imported (Prim)
or else Present (Interface_Alias (Prim))
or else Is_Predefined_Dispatching_Operation (Prim)
or else Is_Eliminated (Prim)
then
null;
@ -7180,6 +7184,10 @@ package body Exp_Disp is
Write_Str (" is null;");
end if;
if Is_Eliminated (Ultimate_Alias (Prim)) then
Write_Str (" (eliminated)");
end if;
Write_Eol;
Next_Elmt (Elmt);

1
gcc/ada/sem_ch6.adb
View File

@ -367,6 +367,7 @@ package body Sem_Ch6 is
end if;
Generate_Reference_To_Formals (Designator);
Check_Eliminated (Designator);
end Analyze_Abstract_Subprogram_Declaration;
----------------------------------------

5
gcc/ada/sem_disp.adb
View File

@ -42,6 +42,7 @@ with Rident; use Rident;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch6; use Sem_Ch6;
with Sem_Elim; use Sem_Elim;
with Sem_Eval; use Sem_Eval;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
@ -483,6 +484,10 @@ package body Sem_Disp is
Set_Controlling_Argument (N, Control);
Check_Restriction (No_Dispatching_Calls, N);
if Is_Eliminated (Ultimate_Alias (Subp_Entity)) then
Eliminate_Error_Msg (N, Ultimate_Alias (Subp_Entity));
end if;
-- If there is a statically tagged actual and a tag-indeterminate
-- call to a function of the ancestor (such as that provided by a
-- default), then treat this as a dispatching call and propagate

26
gcc/ada/sem_elim.adb
View File

@ -269,7 +269,7 @@ package body Sem_Elim is
Elmt := Elim_Hash_Table.Get (Chars (E));
while Elmt /= null loop
declare
Check_Homonyms : declare
procedure Set_Eliminated;
-- Set current subprogram entity as eliminated
@ -279,16 +279,26 @@ package body Sem_Elim is
procedure Set_Eliminated is
begin
-- Never try to eliminate dispatching operation, since we
-- can't properly process the eliminated result. This could
-- be fixed, but is not worth it.
if Is_Dispatching_Operation (E) then
if not Is_Dispatching_Operation (E) then
Set_Is_Eliminated (E);
Elim_Entities.Append ((Prag => Elmt.Prag, Subp => E));
-- If an overriding dispatching primitive is eliminated then
-- its parent must have been eliminated
if Is_Overriding_Operation (E)
and then not Is_Eliminated (Overridden_Operation (E))
then
Error_Msg_Name_1 := Chars (E);
Error_Msg_N ("cannot eliminate subprogram %", E);
return;
end if;
end if;
Set_Is_Eliminated (E);
Elim_Entities.Append ((Prag => Elmt.Prag, Subp => E));
end Set_Eliminated;
-- Start of processing for Check_Homonyms
begin
-- First we check that the name of the entity matches
@ -643,7 +653,7 @@ package body Sem_Elim is
Set_Eliminated;
return;
end if;
end;
end Check_Homonyms;
<<Continue>>
Elmt := Elmt.Homonym;

6
gcc/ada/sem_elim.ads
View File

@ -53,8 +53,8 @@ package Sem_Elim is
-- flag on the given entity.
procedure Eliminate_Error_Msg (N : Node_Id; E : Entity_Id);
-- Called by the back end on encountering a call to an eliminated
-- subprogram. N is the node for the call, and E is the entity of
-- the subprogram being eliminated.
-- Called by the front-end and back-end on encountering a call to an
-- eliminated subprogram. N is the node for the call, and E is the
-- entity of the subprogram being eliminated.
end Sem_Elim;

2
gcc/ada/sem_prag.adb
View File

@ -9226,7 +9226,7 @@ package body Sem_Prag is
-- Cases where we must follow a declaration
else
if Nkind (Decl) not in N_Declaration
if Nkind (Decl) not in N_Declaration
and then Nkind (Decl) not in N_Later_Decl_Item
and then Nkind (Decl) not in N_Generic_Declaration
and then Nkind (Decl) not in N_Renaming_Declaration

15
gcc/ada/sem_type.adb
View File

@ -1425,30 +1425,29 @@ package body Sem_Type is
elsif Is_Numeric_Type (Etype (F1))
and then Has_Abstract_Interpretation (Act1)
then
-- Current interpretation is not the right one because
-- it expects a numeric operand. Examine all the other
-- ones.
-- Current interpretation is not the right one because it
-- expects a numeric operand. Examine all the other ones.
declare
I : Interp_Index;
I : Interp_Index;
It : Interp;
begin
Get_First_Interp (N, I, It);
while Present (It.Typ) loop
if
not Is_Numeric_Type (Etype (First_Formal (It.Nam)))
then
if No (Act2)
or else not Has_Abstract_Interpretation (Act2)
or else not Is_Numeric_Type
(Etype (Next_Formal (First_Formal (It.Nam))))
or else not
Is_Numeric_Type
(Etype (Next_Formal (First_Formal (It.Nam))))
then
return It;
end if;
end if;
Get_Next_Interp (I, It);
end loop;