aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGhjuvan Lacambre <lacambre@adacore.com>2023-02-23 15:20:54 +0100
committerMarc Poulhiès <poulhies@adacore.com>2023-05-26 09:29:16 +0200
commit0e1bba09231634176893908f4402d57ef21477f8 (patch)
tree9e9e5cb09d6bc4bae51474065cb3aa926441686e
parentc8def50f5cb208c29591cec14609f33d2dec92eb (diff)
downloadgcc-0e1bba09231634176893908f4402d57ef21477f8.zip
gcc-0e1bba09231634176893908f4402d57ef21477f8.tar.gz
gcc-0e1bba09231634176893908f4402d57ef21477f8.tar.bz2
ada: Handle new Controlling_Tag format when converting to SCIL
This commit fixes two CodePeer crashes that were introduced when the format of the controlling tag changed. gcc/ada/ * exp_disp.adb (Expand_Dispatching_Call): Handle new Controlling_Tag. * sem_scil.adb (Check_SCIL_Node): Treat N_Object_Renaming_Declaration as N_Object_Declaration.
-rw-r--r--gcc/ada/exp_disp.adb34
-rw-r--r--gcc/ada/sem_scil.adb5
2 files changed, 29 insertions, 10 deletions
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index e7cae38..494ead7 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -1133,18 +1133,36 @@ package body Exp_Disp is
Set_SCIL_Controlling_Tag (SCIL_Node,
Parent (Entity (Prefix (Controlling_Tag))));
- -- For a direct reference of the tag of the type the SCIL node
- -- references the internal object declaration containing the tag
- -- of the type.
+ -- Depending on whether a dereference is involved, the SCIL node
+ -- references the corresponding object/parameter declaration or
+ -- the internal object declaration containing the tag of the type.
elsif Nkind (Controlling_Tag) = N_Attribute_Reference
and then Attribute_Name (Controlling_Tag) = Name_Tag
then
- Set_SCIL_Controlling_Tag (SCIL_Node,
- Parent
- (Node
- (First_Elmt
- (Access_Disp_Table (Entity (Prefix (Controlling_Tag)))))));
+ declare
+ Prefix_Node : constant Node_Id := Prefix (Controlling_Tag);
+ Ent : constant Entity_Id := Entity
+ (if Nkind (Prefix_Node) = N_Explicit_Dereference then
+ Prefix (Prefix_Node)
+ else
+ Prefix_Node);
+
+ begin
+ if Ekind (Ent) in E_Record_Type
+ | E_Record_Subtype
+ | E_Record_Type_With_Private
+ then
+ Set_SCIL_Controlling_Tag (SCIL_Node,
+ Parent
+ (Node
+ (First_Elmt
+ (Access_Disp_Table (Ent)))));
+
+ else
+ Set_SCIL_Controlling_Tag (SCIL_Node, Parent (Ent));
+ end if;
+ end;
-- Interfaces are not supported. For now we leave the SCIL node
-- decorated with the Controlling_Tag. More work needed here???
diff --git a/gcc/ada/sem_scil.adb b/gcc/ada/sem_scil.adb
index 7c75c9d..da8fab6 100644
--- a/gcc/ada/sem_scil.adb
+++ b/gcc/ada/sem_scil.adb
@@ -88,8 +88,9 @@ package body Sem_SCIL is
-- object or parameter declaration. Interface types are still
-- unsupported.
- elsif Nkind (Ctrl_Tag) in
- N_Object_Declaration | N_Parameter_Specification
+ elsif Nkind (Ctrl_Tag) in N_Object_Renaming_Declaration
+ | N_Object_Declaration
+ | N_Parameter_Specification
then
Ctrl_Typ := Etype (Defining_Identifier (Ctrl_Tag));