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

gcc/ada/ChangeLog

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

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);

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);
 	    }
 

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gnat.dg/lto7.adb

+-- { 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;

gcc/testsuite/gnat.dg/lto7_pkg.adb

+package body Lto7_Pkg is
+
+   procedure op1 (this : Root) is begin null; end;
+   procedure op2 (this : DT)   is begin null; end;
+
+end Lto7_Pkg;

gcc/testsuite/gnat.dg/lto7_pkg.ads

+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;