summaryrefslogtreecommitdiff
path: root/gcc/ada/exp_disp.adb
diff options
context:
space:
mode:
authorbstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4>2012-03-01 10:06:45 +0000
committerbstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4>2012-03-01 10:06:45 +0000
commita79ad0b39b356a82b01dcc061d52b506bdf631e9 (patch)
treef75386ffb541630f9a5648bddd8e39156373c57b /gcc/ada/exp_disp.adb
parentee584ef105d93fbf5b26c76ff37371b58bb3da72 (diff)
downloadgcc-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.adb39
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 --
--------------------------