[Ada] Internal crash on illegal renaming
authorHristian Kirtchev <kirtchev@adacore.com>
Thu, 11 Jul 2019 08:01:58 +0000 (08:01 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Thu, 11 Jul 2019 08:01:58 +0000 (08:01 +0000)
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

gcc/ada/ChangeLog
gcc/ada/sem_ch8.adb

index b79a8173388af00973fca6e983555cecf105e812..cc7178b9b58bae1a9912c4155d1b933941d00819 100644 (file)
@@ -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,
index 58abc9c762924f23dac5212003a19f9ef7e4bf0e..90b0c65a8f6f914ba31c08b718574ccf82d5fb7d 100644 (file)
@@ -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