A quantified expression for an array object within a postcondition (and
presumably in other contexts) results in the creation of a renaming of
the array object (such as the formal parameter of the enclosing
postcondition procedure), and when the array's corresponding subtype has
nonstatic bounds those may be declared within an outer subprogram and
need to be referenced up-level. However, the unnesting machinery wasn't
accounting for the possibility of attributes referenced through
renamings, and was picking up the possibly unconstrained (nominal) array
subtype from the entity of the renaming rather than retrieving it via
the renamed array object.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-02 Gary Dismukes <dismu...@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.--- gcc/ada/exp_unst.adb
+++ 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;
--- gcc/ada/sem_util.adb
+++ 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));
--- gcc/ada/sem_util.ads
+++ 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,
