Daily bump.

[pf3gnuchains/gcc-fork.git] / gcc / ada / exp_disp.adb

diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 2ba3150..12cfbdc 100644 (file)
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -75,6 +75,12 @@ package body Exp_Disp is
    --  Ada 2005 (AI-251): Returns the fixed position in the dispatch table
    --  of the default primitive operations.
 
+   function Find_Specific_Type (CW : Entity_Id) return Entity_Id;
+   --  Find specific type of a class-wide type, and handle the case of an
+   --  incomplete type coming either from a limited_with clause or from an
+   --  incomplete type declaration. Shouldn't this be in Sem_Util? It seems
+   --  like a general purpose semantic routine ???
+
    function Has_DT (Typ : Entity_Id) return Boolean;
    pragma Inline (Has_DT);
    --  Returns true if we generate a dispatch table for tagged type Typ
@@ -178,11 +184,7 @@ package body Exp_Disp is
          CW_Typ := Class_Wide_Type (Ctrl_Typ);
       end if;
 
-      Typ := Root_Type (CW_Typ);
-
-      if Ekind (Typ) = E_Incomplete_Type then
-         Typ := Non_Limited_View (Typ);
-      end if;
+      Typ := Find_Specific_Type (CW_Typ);
 
       if not Is_Limited_Type (Typ) then
          Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq);
@@ -746,11 +748,7 @@ package body Exp_Disp is
          CW_Typ := Class_Wide_Type (Ctrl_Typ);
       end if;
 
-      Typ := Root_Type (CW_Typ);
-
-      if Ekind (Typ) = E_Incomplete_Type then
-         Typ := Non_Limited_View (Typ);
-      end if;
+      Typ := Find_Specific_Type (CW_Typ);
 
       if not Is_Limited_Type (Typ) then
          Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq);
@@ -805,6 +803,11 @@ package body Exp_Disp is
       Subp_Ptr_Typ := Create_Itype (E_Access_Subprogram_Type, Call_Node);
       Set_Etype          (Subp_Typ, Res_Typ);
       Set_Returns_By_Ref (Subp_Typ, Returns_By_Ref (Subp));
+      Set_Convention     (Subp_Typ, Convention (Subp));
+
+      --  Notify gigi that the designated type is a dispatching primitive
+
+      Set_Is_Dispatch_Table_Entity (Subp_Typ);
 
       --  Create a new list of parameters which is a copy of the old formal
       --  list including the creation of a new set of matching entities.
@@ -1844,6 +1847,7 @@ package body Exp_Disp is
 
       Thunk_Id := Make_Temporary (Loc, 'T');
       Set_Is_Thunk (Thunk_Id);
+      Set_Convention (Thunk_Id, Convention (Prim));
 
       --  Procedure case
 
@@ -1884,6 +1888,25 @@ package body Exp_Disp is
       end if;
    end Expand_Interface_Thunk;
 
+   ------------------------
+   -- Find_Specific_Type --
+   ------------------------
+
+   function Find_Specific_Type (CW : Entity_Id) return Entity_Id is
+      Typ : Entity_Id := Root_Type (CW);
+
+   begin
+      if Ekind (Typ) = E_Incomplete_Type then
+         if From_With_Type (Typ) then
+            Typ := Non_Limited_View (Typ);
+         else
+            Typ := Full_View (Typ);
+         end if;
+      end if;
+
+      return Typ;
+   end Find_Specific_Type;
+
    --------------------------
    -- Has_CPP_Constructors --
    --------------------------
@@ -6512,7 +6535,7 @@ package body Exp_Disp is
       --  Alignment
 
       --  For CPP types we cannot rely on the value of 'Alignment provided
-      --  by the backend to initialize this TSD field.
+      --  by the backend to initialize this TSD field. Why not???
 
       if Convention (Typ) = Convention_CPP
         or else Is_CPP_Class (Root_Type (Typ))
@@ -8443,8 +8466,9 @@ package body Exp_Disp is
 
                Set_Init_Proc (Typ, Init);
                Set_Is_Imported    (Init);
+               Set_Is_Constructor (Init);
                Set_Interface_Name (Init, Interface_Name (E));
-               Set_Convention     (Init, Convention_C);
+               Set_Convention     (Init, Convention_CPP);
                Set_Is_Public      (Init);
                Set_Has_Completion (Init);
             end if;
@@ -8537,8 +8561,9 @@ package body Exp_Disp is
                   Parameter_Specifications => Parms));
 
             Set_Is_Imported    (Constructor_Id);
+            Set_Is_Constructor (Constructor_Id);
             Set_Interface_Name (Constructor_Id, Interface_Name (E));
-            Set_Convention     (Constructor_Id, Convention_C);
+            Set_Convention     (Constructor_Id, Convention_CPP);
             Set_Is_Public      (Constructor_Id);
             Set_Has_Completion (Constructor_Id);