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

exp_disp.adb (Make_Tags): Mark the imported view of dispatch tables built for interfaces. 

* exp_disp.adb (Make_Tags): Mark the imported view of dispatch tables
	built for interfaces.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Use
	imported_p instead of Is_Imported when considering constants.
	Do not promote alignment of exported objects.
	<E_Record_Subtype>: Strip all suffixes for dispatch table entities.

From-SVN: r159247
This commit is contained in:
Eric Botcazou 2010-05-10 21:52:45 +00:00 committed by Eric Botcazou
parent 5a40306bb6
commit c679a9157b
7 changed files with 59 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/ada/ChangeLog
View File

@ -1,3 +1,12 @@
2010-05-10 Eric Botcazou <ebotcazou@adacore.com>
* exp_disp.adb (Make_Tags): Mark the imported view of dispatch tables
built for interfaces.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Use
imported_p instead of Is_Imported when considering constants.
Do not promote alignment of exported objects.
<E_Record_Subtype>: Strip all suffixes for dispatch table entities.
2010-05-08 Eric Botcazou <ebotcazou@adacore.com>
* exp_disp.adb (Make_Tags): Mark the imported view of dispatch tables.

7
gcc/ada/exp_disp.adb
View File

@ -6244,7 +6244,7 @@ package body Exp_Disp is
DT : Node_Id := Empty;
DT_Ptr : Node_Id;
Predef_Prims_Ptr : Node_Id;
Iface_DT : Node_Id;
Iface_DT : Node_Id := Empty;
Iface_DT_Ptr : Node_Id;
New_Node : Node_Id;
Suffix_Index : Int;
@ -6570,6 +6570,11 @@ package body Exp_Disp is
Set_Is_Dispatch_Table_Entity (Etype (DT));
end if;
if Present (Iface_DT) then
Set_Is_Dispatch_Table_Entity (Iface_DT);
Set_Is_Dispatch_Table_Entity (Etype (Iface_DT));
end if;
Set_Ekind (DT_Ptr, E_Constant);
Set_Is_Tag (DT_Ptr);
Set_Related_Type (DT_Ptr, Typ);

9
gcc/ada/gcc-interface/decl.c
View File

@ -561,7 +561,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
== N_Object_Declaration)
&& Present (Expression (Declaration_Node (gnat_entity))))
|| Present (Renamed_Object (gnat_entity))
|| Is_Imported (gnat_entity)));
|| imported_p));
bool inner_const_flag = const_flag;
bool static_p = Is_Statically_Allocated (gnat_entity);
bool mutable_p = false;
@ -742,6 +742,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& kind != E_Out_Parameter
&& Is_Composite_Type (Etype (gnat_entity))
&& !Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
&& !Is_Exported (gnat_entity)
&& !imported_p
&& No (Renamed_Object (gnat_entity))
&& No (Address_Clause (gnat_entity))))
@ -1000,7 +1001,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if ((Treat_As_Volatile (gnat_entity)
|| (!const_flag
&& (Is_Exported (gnat_entity)
|| Is_Imported (gnat_entity)
|| imported_p
|| Present (Address_Clause (gnat_entity)))))
&& !TYPE_VOLATILE (gnu_type))
gnu_type = build_qualified_type (gnu_type,
@ -2984,9 +2985,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{
char *p;
Get_Encoded_Name (gnat_entity);
p = strrchr (Name_Buffer, '_');
p = strchr (Name_Buffer, '_');
gcc_assert (p);
strcpy (p+1, "dtS");
strcpy (p+2, "dtS");
gnu_entity_name = get_identifier (Name_Buffer);
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2010-05-10 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/lto7.adb: New test.
* gnat.dg/lto7_pkg.ad[sb]: New helper.
2010-05-10 Jason Merrill <jason@redhat.com>
PR c++/44017

12
gcc/testsuite/gnat.dg/lto7.adb Normal file
View File

@ -0,0 +1,12 @@
-- { dg-do run }
-- { dg-options "-flto" { target lto } }
with Lto7_Pkg; use Lto7_Pkg;
procedure Lto7 is
view2 : access Iface_2'Class;
obj : aliased DT := (m_name => "Abdu");
begin
view2 := Iface_2'Class(obj)'Access;
view2.all.op2;
end;

6
gcc/testsuite/gnat.dg/lto7_pkg.adb Normal file
View File

@ -0,0 +1,6 @@
package body Lto7_Pkg is
procedure op1 (this : Root) is begin null; end;
procedure op2 (this : DT) is begin null; end;
end Lto7_Pkg;

16
gcc/testsuite/gnat.dg/lto7_pkg.ads Normal file
View File

@ -0,0 +1,16 @@
package Lto7_Pkg is
type Iface_1 is interface;
procedure op1(this : Iface_1) is abstract;
type Iface_2 is interface;
procedure op2 (this : Iface_2) is abstract;
type Root is new Iface_1 with record
m_name : String(1..4);
end record;
procedure op1 (this : Root);
type DT is new Root and Iface_2 with null record;
procedure op2 (this : DT);
end Lto7_Pkg;