diff options
author | Ghjuvan Lacambre <lacambre@adacore.com> | 2023-02-23 15:20:54 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-05-26 09:29:16 +0200 |
commit | 0e1bba09231634176893908f4402d57ef21477f8 (patch) | |
tree | 9e9e5cb09d6bc4bae51474065cb3aa926441686e | |
parent | c8def50f5cb208c29591cec14609f33d2dec92eb (diff) | |
download | gcc-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.adb | 34 | ||||
-rw-r--r-- | gcc/ada/sem_scil.adb | 5 |
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)); |