diff options
author | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-03-01 10:06:45 +0000 |
---|---|---|
committer | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-03-01 10:06:45 +0000 |
commit | a79ad0b39b356a82b01dcc061d52b506bdf631e9 (patch) | |
tree | f75386ffb541630f9a5648bddd8e39156373c57b /gcc/ada/exp_disp.adb | |
parent | ee584ef105d93fbf5b26c76ff37371b58bb3da72 (diff) | |
download | gcc-a79ad0b39b356a82b01dcc061d52b506bdf631e9.tar.gz |
2012-03-01 Basile Starynkevitch <basile@starynkevitch.net>
MELT branch merged with trunk rev 184686 using svnmerge
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@184689 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/exp_disp.adb')
-rw-r--r-- | gcc/ada/exp_disp.adb | 39 |
1 files changed, 28 insertions, 11 deletions
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 23ffe90c5fd..e065538c72b 100644 --- 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); @@ -1884,6 +1882,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 -- -------------------------- |