[gcc r14-1265] ada: Handle new Controlling_Tag format when converting to SCIL

[gcc r14-1265] ada: Handle new Controlling_Tag format when converting to SCIL

[Marc Poulhi?s]

https://gcc.gnu.org/g:0e1bba09231634176893908f4402d57ef21477f8

commit r14-1265-g0e1bba09231634176893908f4402d57ef21477f8
Author: Ghjuvan Lacambre <lacambre@adacore.com>
Date:   Thu Feb 23 15:20:54 2023 +0100

    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.

Diff:
---
 gcc/ada/exp_disp.adb | 34 ++++++++++++++++++++++++++--------
 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 e7cae38d553..494ead7c144 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 7c75c9d66bc..da8fab69a97 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));