This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix LTO warning with tagged types
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Sat, 8 May 2010 13:48:24 +0200
- Subject: [Ada] Fix LTO warning with tagged types
Static dispatch tables use a trick to break up circularity problems: first
they are declared as imported constants then defined as exported constants.
This leads to problems with type merging in LTO mode because a specific
subtype is used in each case.
Tested on i586-suse-linux, applied on the mainline.
2010-05-08 Eric Botcazou <ebotcazou@adacore.com>
* exp_disp.adb (Make_Tags): Mark the imported view of dispatch tables.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Make imported
constants really constant.
<E_Record_Subtype>: Strip the suffix for dispatch table entities.
2010-05-08 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/lto5.adb: New test.
* gnat.dg/lto5_pkg.ad[sb]: New helper.
--
Eric Botcazou
Index: exp_disp.adb
===================================================================
--- exp_disp.adb (revision 159144)
+++ exp_disp.adb (working copy)
@@ -6241,7 +6241,7 @@ package body Exp_Disp is
Tname : constant Name_Id := Chars (Typ);
AI_Tag_Comp : Elmt_Id;
- DT : Node_Id;
+ DT : Node_Id := Empty;
DT_Ptr : Node_Id;
Predef_Prims_Ptr : Node_Id;
Iface_DT : Node_Id;
@@ -6562,6 +6562,14 @@ package body Exp_Disp is
end;
end if;
+ -- Mark entities of dispatch table. Required by the back end to
+ -- handle them properly.
+
+ if Present (DT) then
+ Set_Is_Dispatch_Table_Entity (DT);
+ Set_Is_Dispatch_Table_Entity (Etype (DT));
+ end if;
+
Set_Ekind (DT_Ptr, E_Constant);
Set_Is_Tag (DT_Ptr);
Set_Related_Type (DT_Ptr, Typ);
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 159183)
+++ gcc-interface/decl.c (working copy)
@@ -560,7 +560,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
&& (((Nkind (Declaration_Node (gnat_entity))
== N_Object_Declaration)
&& Present (Expression (Declaration_Node (gnat_entity))))
- || Present (Renamed_Object (gnat_entity))));
+ || Present (Renamed_Object (gnat_entity))
+ || Is_Imported (gnat_entity)));
bool inner_const_flag = const_flag;
bool static_p = Is_Statically_Allocated (gnat_entity);
bool mutable_p = false;
@@ -2975,6 +2976,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
break;
}
+ /* If this is a record subtype associated with a dispatch table,
+ strip the suffix. This is necessary to make sure 2 different
+ subtypes associated with the imported and exported views of a
+ dispatch table are properly merged in LTO mode. */
+ if (Is_Dispatch_Table_Entity (gnat_entity))
+ {
+ char *p;
+ Get_Encoded_Name (gnat_entity);
+ p = strrchr (Name_Buffer, '_');
+ gcc_assert (p);
+ strcpy (p+1, "dtS");
+ gnu_entity_name = get_identifier (Name_Buffer);
+ }
+
/* When the subtype has discriminants and these discriminants affect
the initial shape it has inherited, factor them in. But for an
Unchecked_Union (it must be an Itype), just return the type.
-- { dg-do run }
-- { dg-options "-flto" }
with Lto5_Pkg;
procedure Lto5 is
begin
null;
end;
pragma Eliminate (p, d);
package Lto5_Pkg is
type t is tagged null record;
procedure d (a : t);
end;
package body Lto5_Pkg is
procedure d (a : t) is
begin
null;
end;
end;