From: Hristian Kirtchev <kirtchev@adacore.com>
Date: Thu, 11 Jul 2019 08:01:58 +0000 (+0000)
Subject: [Ada] Internal crash on illegal renaming
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=bce6accb664712f2d046bad9566fee810b43fed6;p=gcc.git

[Ada] Internal crash on illegal renaming

This patch updates the retrieval of the renamed object name of an object
renaming declaration to handle various name forms.

No need for a test because one already exists, and reproducing requires
a compiler built with assertions.

2019-07-11  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* sem_ch8.adb (Analyze_Object_Renaming): Obtain the object being
	renamed using routine Get_Object_Name which takes care of
	various name forms.
	(Get_Object_Name): New routine.

From-SVN: r273387
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b79a8173388..cc7178b9b58 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-11  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch8.adb (Analyze_Object_Renaming): Obtain the object being
+	renamed using routine Get_Object_Name which takes care of
+	various name forms.
+	(Get_Object_Name): New routine.
+
 2019-07-11  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch6.adb (Can_Fold_Predicate_Call): New function,
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 58abc9c7629..90b0c65a8f6 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -774,6 +774,10 @@ package body Sem_Ch8 is
       --  has already established its actual subtype. This is only relevant
       --  if the renamed object is an explicit dereference.
 
+      function Get_Object_Name (Nod : Node_Id) return Node_Id;
+      --  Obtain the name of the object from node Nod which is being renamed by
+      --  the object renaming declaration N.
+
       ------------------------------
       -- Check_Constrained_Object --
       ------------------------------
@@ -840,6 +844,33 @@ package body Sem_Ch8 is
          end if;
       end Check_Constrained_Object;
 
+      ---------------------
+      -- Get_Object_Name --
+      ---------------------
+
+      function Get_Object_Name (Nod : Node_Id) return Node_Id is
+         Obj_Nam : Node_Id;
+
+      begin
+         Obj_Nam := Nod;
+         while Present (Obj_Nam) loop
+            if Nkind_In (Obj_Nam, N_Attribute_Reference,
+                                  N_Explicit_Dereference,
+                                  N_Indexed_Component,
+                                  N_Slice)
+            then
+               Obj_Nam := Prefix (Obj_Nam);
+
+            elsif Nkind (Obj_Nam) = N_Selected_Component then
+               Obj_Nam := Selector_Name (Obj_Nam);
+            else
+               exit;
+            end if;
+         end loop;
+
+         return Obj_Nam;
+      end Get_Object_Name;
+
    --  Start of processing for Analyze_Object_Renaming
 
    begin
@@ -1156,18 +1187,10 @@ package body Sem_Ch8 is
 
       elsif Ada_Version >= Ada_2005 and then Nkind (Nam) in N_Has_Entity then
          declare
-            Nam_Decl : Node_Id;
-            Nam_Ent  : Entity_Id;
+            Nam_Ent  : constant Entity_Id := Entity (Get_Object_Name (Nam));
+            Nam_Decl : constant Node_Id   := Declaration_Node (Nam_Ent);
 
          begin
-            if Nkind (Nam) = N_Attribute_Reference then
-               Nam_Ent := Entity (Prefix (Nam));
-            else
-               Nam_Ent := Entity (Nam);
-            end if;
-
-            Nam_Decl := Parent (Nam_Ent);
-
             if Has_Null_Exclusion (N)
               and then not Has_Null_Exclusion (Nam_Decl)
             then