* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159247 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 68a9266..e361cca 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.

diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index f21b8d2..b7f31c3 100644 (file)
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -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);

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index fba552b..3118cfc 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -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);
            }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3440960..81b584b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gnat.dg/lto7.adb b/gcc/testsuite/gnat.dg/lto7.adb
new file mode 100644 (file)
index 0000000..cb81495
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/lto7.adb
@@ -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;

diff --git a/gcc/testsuite/gnat.dg/lto7_pkg.adb b/gcc/testsuite/gnat.dg/lto7_pkg.adb
new file mode 100644 (file)
index 0000000..dd973da
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/lto7_pkg.adb
@@ -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;

diff --git a/gcc/testsuite/gnat.dg/lto7_pkg.ads b/gcc/testsuite/gnat.dg/lto7_pkg.ads
new file mode 100644 (file)
index 0000000..284745f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/lto7_pkg.ads
@@ -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;