+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,
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
Next_Elmt (Prim_Elmt);
end loop;
+
Freezing_Library_Level_Tagged_Type := Save;
end;
end if;
if Is_Imported (Prim)
or else Present (Interface_Alias (Prim))
or else Is_Predefined_Dispatching_Operation (Prim)
+ or else Is_Eliminated (Prim)
then
null;
Write_Str (" is null;");
end if;
+ if Is_Eliminated (Ultimate_Alias (Prim)) then
+ Write_Str (" (eliminated)");
+ end if;
+
Write_Eol;
Next_Elmt (Elmt);
end if;
Generate_Reference_To_Formals (Designator);
+ Check_Eliminated (Designator);
end Analyze_Abstract_Subprogram_Declaration;
----------------------------------------
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;
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
Elmt := Elim_Hash_Table.Get (Chars (E));
while Elmt /= null loop
- declare
+ Check_Homonyms : declare
procedure Set_Eliminated;
-- Set current subprogram entity as eliminated
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
Set_Eliminated;
return;
end if;
- end;
+ end Check_Homonyms;
<<Continue>>
Elmt := Elmt.Homonym;
-- 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;
-- 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
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;
projects / thirdparty / gcc.git / commitdiff
