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 --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index e7cae38d5530ad94fe21ee4f7cc9e528fda337fe..494ead7c144dcf3c85de4511cf5fc2d954af3239 100644 (file)
--- 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 7c75c9d66bc0436ce1251e02114dbd6c1af9c749..da8fab69a97ebbfa0c80be25e0aca901f2b0cd49 100644 (file)
--- 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));