From: Ghjuvan Lacambre <lacam...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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));
--
2.40.0
