[gcc/devel/gccgo] [Ada] Unnesting bugs with array renamings generated for quantified expr

[Ian Lance Taylor]

https://gcc.gnu.org/g:9b95ecdf3dc3faa04c60e8c09f3dafa6e6a1aab1

commit 9b95ecdf3dc3faa04c60e8c09f3dafa6e6a1aab1
Author: Gary Dismukes <dismukes@adacore.com>
Date:   Mon Dec 16 18:43:32 2019 -0500

    [Ada] Unnesting bugs with array renamings generated for quantified expr
    
    2020-06-02  Gary Dismukes  <dismukes@adacore.com>
    
    gcc/ada/
    
            * exp_unst.adb (Visit_Node): When visiting array attribute
            nodes, apply Get_Referenced_Object to the attribute prefix, to
            handle prefixes denoting renamed objects by picking up the Etype
            of the renamed object rather than the possibly unconstrained
            nominal subtype of the renaming declaration's Entity.
            * sem_util.ads (Get_Referenced_Object): Update comment to
            clearly indicate that any kind of node can be passed to this
            function.
            * sem_util.adb (Get_Referenced_Object): Add test of Is_Object to
            the condition, to allow for passing names that denote types and
            subtypes.

Diff:
---
 gcc/ada/exp_unst.adb | 13 ++++++++++---
 gcc/ada/sem_util.adb |  1 +
 gcc/ada/sem_util.ads |  7 ++++---
 3 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 1747281a00b..1460b641b19 100644
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -1042,14 +1042,21 @@ package body Exp_Unst is
                            --  handled during full traversal. Note that if the
                            --  nominal subtype of the prefix is unconstrained,
                            --  the bound must be obtained from the object, not
-                           --  from the (possibly) uplevel reference.
+                           --  from the (possibly) uplevel reference. We call
+                           --  Get_Referenced_Object to deal with prefixes that
+                           --  are object renamings (prefixes that are types
+                           --  can be passed and will simply be returned).
 
-                           if Is_Constrained (Etype (Prefix (N))) then
+                           if Is_Constrained
+                                (Etype (Get_Referenced_Object (Prefix (N))))
+                           then
                               declare
                                  DT : Boolean := False;
                               begin
                                  Check_Static_Type
-                                   (Etype (Prefix (N)), Empty, DT);
+                                   (Etype (Get_Referenced_Object (Prefix (N))),
+                                    Empty,
+                                    DT);
                               end;
 
                               return OK;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 650226e96ec..064e613b4fc 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10181,6 +10181,7 @@ package body Sem_Util is
    begin
       R := N;
       while Is_Entity_Name (R)
+        and then Is_Object (Entity (R))
         and then Present (Renamed_Object (Entity (R)))
       loop
          R := Renamed_Object (Entity (R));
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index c148a50d72b..6c3fded4d51 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1138,9 +1138,10 @@ package Sem_Util is
    --  corresponding aspect.
 
    function Get_Referenced_Object (N : Node_Id) return Node_Id;
-   --  Given a node, return the renamed object if the node represents a renamed
-   --  object, otherwise return the node unchanged. The node may represent an
-   --  arbitrary expression.
+   --  Given an arbitrary node, return the renamed object if the node
+   --  represents a renamed object; otherwise return the node unchanged.
+   --  The node can represent an arbitrary expression or any other kind of
+   --  node (such as the name of a type).
 
    function Get_Renamed_Entity (E : Entity_Id) return Entity_Id;
    --  Given an entity for an exception, package, subprogram or generic unit,