aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_util.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/sem_util.adb')
-rw-r--r--gcc/ada/sem_util.adb74
1 files changed, 66 insertions, 8 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e846845..156d247 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1564,22 +1564,48 @@ package body Sem_Util is
function Search_Tag (Iface : Entity_Id) return Entity_Id is
ADT : Elmt_Id;
-
begin
- ADT := Next_Elmt (Next_Elmt (First_Elmt (Access_Disp_Table (T))));
+ if not Is_CPP_Class (T) then
+ ADT := Next_Elmt (Next_Elmt (First_Elmt (Access_Disp_Table (T))));
+ else
+ ADT := Next_Elmt (First_Elmt (Access_Disp_Table (T)));
+ end if;
+
while Present (ADT)
- and then Ekind (Node (ADT)) = E_Constant
+ and then Is_Tag (Node (ADT))
and then Related_Type (Node (ADT)) /= Iface
loop
- -- Skip the secondary dispatch tables of Iface
+ -- Skip secondary dispatch table referencing thunks to user
+ -- defined primitives covered by this interface.
+ pragma Assert (Has_Suffix (Node (ADT), 'P'));
Next_Elmt (ADT);
- Next_Elmt (ADT);
- Next_Elmt (ADT);
- Next_Elmt (ADT);
+
+ -- Skip secondary dispatch tables of Ada types
+
+ if not Is_CPP_Class (T) then
+
+ -- Skip secondary dispatch table referencing thunks to
+ -- predefined primitives.
+
+ pragma Assert (Has_Suffix (Node (ADT), 'Y'));
+ Next_Elmt (ADT);
+
+ -- Skip secondary dispatch table referencing user-defined
+ -- primitives covered by this interface.
+
+ pragma Assert (Has_Suffix (Node (ADT), 'D'));
+ Next_Elmt (ADT);
+
+ -- Skip secondary dispatch table referencing predefined
+ -- primitives
+
+ pragma Assert (Has_Suffix (Node (ADT), 'Z'));
+ Next_Elmt (ADT);
+ end if;
end loop;
- pragma Assert (Ekind (Node (ADT)) = E_Constant);
+ pragma Assert (Is_Tag (Node (ADT)));
return Node (ADT);
end Search_Tag;
@@ -2499,6 +2525,28 @@ package body Sem_Util is
end if;
end Designate_Same_Unit;
+ --------------------------
+ -- Enclosing_CPP_Parent --
+ --------------------------
+
+ function Enclosing_CPP_Parent (Typ : Entity_Id) return Entity_Id is
+ Parent_Typ : Entity_Id := Typ;
+
+ begin
+ while not Is_CPP_Class (Parent_Typ)
+ and then Etype (Parent_Typ) /= Parent_Typ
+ loop
+ Parent_Typ := Etype (Parent_Typ);
+
+ if Is_Private_Type (Parent_Typ) then
+ Parent_Typ := Full_View (Base_Type (Parent_Typ));
+ end if;
+ end loop;
+
+ pragma Assert (Is_CPP_Class (Parent_Typ));
+ return Parent_Typ;
+ end Enclosing_CPP_Parent;
+
----------------------------
-- Enclosing_Generic_Body --
----------------------------
@@ -5208,6 +5256,16 @@ package body Sem_Util is
end if;
end Has_Stream;
+ ----------------
+ -- Has_Suffix --
+ ----------------
+
+ function Has_Suffix (E : Entity_Id; Suffix : Character) return Boolean is
+ begin
+ Get_Name_String (Chars (E));
+ return Name_Buffer (Name_Len) = Suffix;
+ end Has_Suffix;
+
--------------------------
-- Has_Tagged_Component --
--------------------------